perm filename QIO.LST[NEW,LSP] blob
sn#381640 filedate 1978-09-18 generic text, type T, neo UTF8
SAIL RPG 15:02:51 Monday, September 18, 1978 FM+1D.17H.19M.52S.
QIO[NEW,LSP] Created 11:57 Monday, September 18, 1978 FM+1D.14H.14M.1S.
QQQQQQQQQ IIIIIIIII OOOOOOOOO
QQQQQQQQQ IIIIIIIII OOOOOOOOO
QQQ QQQ III OOO OOO
QQQ QQQ III OOO OOO
QQQ QQQ III OOO OOO
QQQ QQQ III OOO OOO
QQQ QQQ III OOO OOO
QQQ QQQ III OOO OOO
QQQ QQQ QQQ III OOO OOO
QQQ QQQ QQQ III OOO OOO
QQQ QQQ III OOO OOO
QQQ QQQ III OOO OOO
QQQQQQ QQQ IIIIIIIII OOOOOOOOO
QQQQQQ QQQ IIIIIIIII OOOOOOOOO
SAIL RPG 15:02:51 Monday, September 18, 1978 FM+1D.17H.19M.52S.
QIO[NEW,LSP] Created 11:57 Monday, September 18, 1978 FM+1D.14H.14M.1S.
Switch Settings: L[FAIL] % 54V 120W ↑
SAIL RPG 15:02:51 Monday, September 18, 1978 FM+1D.17H.19M.52S.
QIO[NEW,LSP] Created 11:57 Monday, September 18, 1978 FM+1D.14H.14M.1S.
QQQQQQQQQ IIIIIIIII OOOOOOOOO
QQQQQQQQQ IIIIIIIII OOOOOOOOO
QQQ QQQ III OOO OOO
QQQ QQQ III OOO OOO
QQQ QQQ III OOO OOO
QQQ QQQ III OOO OOO
QQQ QQQ III OOO OOO
QQQ QQQ III OOO OOO
QQQ QQQ QQQ III OOO OOO
QQQ QQQ QQQ III OOO OOO
QQQ QQQ III OOO OOO
QQQ QQQ III OOO OOO
QQQQQQ QQQ IIIIIIIII OOOOOOOOO
QQQQQQ QQQ IIIIIIIII OOOOOOOOO
SAIL RPG 15:02:51 Monday, September 18, 1978 FM+1D.17H.19M.52S.
QIO[NEW,LSP] Created 11:57 Monday, September 18, 1978 FM+1D.14H.14M.1S.
Switch Settings: L[FAIL] % 54V 120W ↑
QIO[NEW,LSP] 09/18/78 Page 1
001 COMMENT ⊗ VALID 00047 PAGES
002 C REC PAGE DESCRIPTION
003 C00001 00001
004 C00005 00002 -*-MIDAS-*-
005 C00009 00003 ALFILE CREATES A MINIMAL FILE ARRAY (OF LENGTH LOPOFA),
006 C00012 00004 FILE OBJECT CHECKING ROUTINES
007 C00014 00005 THESE ROUTINES ACCEPT A FILE ARRAY IN AR1 AND CHECK WHETHER
008 C00017 00006 CONVERSION: NAMELIST => SIXBIT
009 C00038 00007 CONVERSION: SIXBIT => NAMELIST
010 C00041 00008 CONVERSION: SIXBIT => NAMESTRING
011 C00050 00009 CONVERSION: NAMESTRING => SIXBIT
012 C00063 00010 IFN D20,[
013 C00067 00011 CONVERSION: ANY FILE SPEC => SIXBIT
014 C00070 00012 MERGING ROUTINES, MERGEF, TRUENAME, PROBEF
015 C00076 00013 ROUTINE TO SET UP ARGS FOR TWO-ARGUMENT FILE FUNCTION.
016 C00082 00014 RENAMEF FUNCTION, CNAMEF FUNCTION
017 C00090 00015 DELETEF FUNCTION
018 C00095 00016 CLOSE FUNCTION
019 C00098 00017 FORCE-OUTPUT
020 C00102 00018 STATUS FILEMODE
021 C00106 00019 LOAD FUNCTION
022 C00115 00020 OPEN FUNCTION (INCLUDING SAIL EOPEN)
023 C00120 00021 SA% $EOPEN:
024 C00123 00022 LEFT HALF IS SET OF MODE BITS WHICH THE OPTION IN THE RIGHT
025 C00125 00023 STATE OF THE WORLD:
026 C00131 00024 FALLS IN
027 C00134 00025 FALLS IN
028 C00142 00026 FALLS IN
029 C00150 00027 OPNBO1:
030 C00153 00028 OPNTO1:
031 C00156 00029 IFN ITS,[
032 C00158 00030 VARIOUS ERROR HANDLERS - ARRIVE WITH A MESSAGE IN C.
033 C00160 00031 IFN ITS,[
034 C00162 00032 TABLES FOR OPEN FUNCTION
035 C00165 00033 OPEN9C CONTAINS THE OPEN MODE WORD. FOR D10, THE MODE IS ALWAYS
036 C00171 00034 DEFAULTF, ENDPAGEFN, EOFFN
037 C00174 00035 LISTEN FUNCTION
038 C00177 00036 LINEL, PAGEL, CHARPOS, LINENUM, PAGENUM
039 C00181 00037 IN
040 C00187 00038 OUT
041 C00190 00039 FILEPOS, LENGTHF
042 C00193 00040 TWO-ARGUMENT CASE: SET FILE POSITION
043 C00201 00041 CONTROL-P CODES AND TTY INITIALIZATION
044 C00207 00042 IFN ITS
045 C00211 00043 ROUTINE FOR OPENING UP THE INITIAL TTY FILE ARRAYS.
046 C00215 00044 CLEAR-INPUT, CLEAR-OUTPUT
047 C00217 00045 (CLEAR-OUTPUT X) CLEARS ANY OUTPUT NOT ACTUALLY ON
048 C00219 00046 STANDARD **MORE** PROCESSOR
049 C00221 00047 IFN SFA,[
050 C00235 ENDMK
051 C⊗;
I/O CHANNEL ALLOCATOR QIO[NEW,LSP] 09/18/78 Page 2
001 ;;; -*-MIDAS-*-
002 ;;; **************************************************************
003 ;;; ***** MACLISP ****** NEW MULTIPLE FILE I/O FUNCTIONS *********
004 ;;; **************************************************************
005 ;;; ** (C) COPYRIGHT 1978 MASSACHUSETTS INSTITUTE OF TECHNOLOGY **
006 ;;; ****** THIS IS A READ-ONLY FILE! (ALL WRITES RESERVED) *******
007 ;;; **************************************************************
008
009
010 PGBOT [QIO]
011
012 SUBTTL I/O CHANNEL ALLOCATOR
013
014 ;;; ALCHAN ALLOCATES AN I/O CHANNEL FOR USE.
015 ;;; THE "CHANNEL NUMBER" IS AN INDEX INTO THE CHANNEL TABLE.
016 .SEE CHNTB
017 ;;; FOR ITS AND DEC10, THIS IS ALSO THE CHANNEL NUMBER USED TO
018 ;;; COMMUNICATE WITH THE TIMESHARING SYSTEM. (FOR DEC20, A
019 ;;; SEPARATE JFN MUST BE ALLOCATED WITH THE GTJFN JSYS.)
020 ;;; ALCHAN EXPECTS THE SAR FOR THE FILE ARRAY TO BE IN A,
021 ;;; AND RETURNS THE CHANNEL NUMBER IN F, SKIPPING IF SUCCESSFUL.
022 ;;; THE FILE ARRAY MUST HAVE ITS TTS.CL BIT SET.
023 ;;; THE CHANNEL NUMBER IS INSTALLED IN THE FILE'S F.CHAN SLOT.
024 ;;; USER INTERRUPTS TURNED OFF, PLEASE. CLOBBERS R.
025 ;;; MAY INVOKE A GARBAGE COLLECTION TO FREE UP CHANNELS.
026
027 ALCHAN: HRRZS (P)
028 ALCHN0: MOVNI F,LCHNTB-2 ;SCAN CHANNEL TABLE
029 ALCHN1: SKIPN R,CHNTB+LCHNTB-1(F)
030 002 051 JRST ALCHN3 ;FOUND A FREE CHANNEL
031 MOVE R,TTSAR(R)
032 TLNE R,TTS<CL>
033 002 041 JRST ALCHN2 ;SEMI-FREE
034 002 029 AOJLE F,ALCHN1 ;DON'T CHECK CHANNEL 0 (NEVER FREE)
035 SKIPGE (P) ;SKIP IF FIRST TIME
036 POPJ P, ;LOSEY LOSEY
037 HRROS (P) ;SET SWITCH
038 002 028 PUSH P,[555555,,ALCHN0]
039 JRST AGC ;HOPE GC WILL RECLAIM A FILE ARRAY
040
041 ALCHN2: MOVEI F,LCHNTB-1(F)
042 002 058 IT$ .CALL ALCHN9 ;CLOSE CHANNEL TO BE SURE
043 IT$ .LOSE 1400
044 IFN D10,[
045 MOVEI R,(F)
046 LSH R,27
047 IOR R,[RELEASE 0,0] ;RELEASE CHANNEL TO BE SURE
048 XCT R
049 ] ;END OF IFN D10
050 SKIPA
051 ALCHN3: MOVEI F,LCHNTB-1(F)
052 MOVE R,TTSAR(A) ;INSTALL CHANNEL NUMBER
053 MOVEM F,F.CHAN(R)
I/O CHANNEL ALLOCATOR QIO[NEW,LSP] 09/18/78 Page 2.1
054 MOVEM A,CHNTB(F) ;RESERVE CHANNEL
055 JRST POPJ1 ;WIN WIN - SKIP RETURN
056
057 IFN ITS,[
058 ALCHN9: SETZ
059 SIXBIT \CLOSE\ ;CLOSE I/O CHANNEL
060 400000,,F ;CHANNEL #
061 ] ;END OF IFN ITS
I/O CHANNEL ALLOCATOR QIO[NEW,LSP] 09/18/78 Page 3
001 ;;; ALFILE CREATES A MINIMAL FILE ARRAY (OF LENGTH LOPOFA),
002 ;;; AND ALLOCATES A CHANNEL FOR IT. IT EXPECTS A DEVICE NAME
003 ;;; IN TT (FOR DEC20, TT AND D) WHICH IS INSTALLED IN THE
004 ;;; F.DEV AND F.RDEV SLOTS OF THE FILE ARRAY.
005 ;;; THIS IS USEFUL FOR ROUTINES WHICH WANT TO HACK ON A
006 ;;; RANDOM CHANNEL BUT DON'T NEED A FULL-BLOWN FILE ARRAY.
007 ;;; A FILE ARRAY IS NEEDED FOR THE SAKE OF THE CHANNEL TABLE
008 .SEE CHNTB
009 ;;; AND FOR THE GARBAGE COLLECTOR; IF THE FILE ARRAY IS
010 ;;; GARBAGE COLLECTED, SO IS THE ASSOCIATED CHANNEL.
011 ;;; THE FILE ARRAY ALSO MUST CONTAIN AT LEAST A DEVICE
012 ;;; NAME SO PRIN1 CAN WIN.
013 .SEE PRNFL
014 ;;; CLOBBERS PRACTICALLY ALL ACS.
015 ;;; THE ARRAY GC POINTER IS SET TO PROTECT THE FIRST SLOT ONLY.
016 ;;; RETURNS FILE ARRAY IN A, CHANNEL NUMBER IN F.
017 ;;; SKIPS ON SUCCESS; FAILS IF ALCHAN CAN'T GET A CHANNEL.
018
019 ALFILE: LOCKI
020 PUSH FXP,TT
021 MOVEI TT,LOPOFA ;LENGTH OF PLAIN OLD FILE ARRAY
022 MOVSI A,-1 ;GET ONLY A SAR
023 PUSHJ P,MKLSAR
024 MOVSI TT,TTS<CL> ;SET CLOSED BIT
025 IORB TT,TTSAR(A)
026 MOVSI T,AS<FIL> ;SET FILE ARRAY BIT (MUST DO
027 IORB T,ASAR(A) ; IN THIS ORDER!)
028 HRROS -1(T) ;GC SHOULD PROTECT ONLY ONE SLOT
029 POP FXP,T
030 MOVEM T,F.DEV(TT) ;INSTALL DEVICE NAME
031 20% MOVEM T,F.RDEV(TT)
032 MOVSI T,FBT.CM ;PREVENT GC FROM TRYING TO
033 MOVEM T,F.MODE(TT) ; UPDATE NONEXISTENT POINTERS
034 002 027 PUSHJ P,ALCHAN
035 003 039 JRST UNLKPJ
036 AOS (P) ;WE SKIP IFF ALCHAN DOES
037 MOVSI TT,TTS<CL>
038 ANDCAM TT,TTSAR(A)
039 UNLKPJ: UNLKPOPJ
FILE OBJECT CHECKING ROUTINES QIO[NEW,LSP] 09/18/78 Page 4
001 SUBTTL FILE OBJECT CHECKING ROUTINES
002
003 ;;; JSP TT,XFILEP
004 ;;; SKIPS IFF THE OBJECT IN AR1 IS A FILE ARRAY. CLOBBERS R.
005 SFA% AFOSP:
006 AFILEP: MOVEI AR1,(A)
007 SFA% XFOSP:
008 XFILEP: MOVEI R,(AR1)
009 LSH R,-SEGLOG
010 MOVE R,ST(R)
011 TLNN R,SA
012 JRST (TT)
013 MOVE R,ASAR(AR1) ;MUST ALSO HAVE FILE BIT SET
014 TLNN R,AS<FIL>
015 JRST (TT)
016 JRST 1(TT)
017
018 004 006 FILEP: JSP TT,AFILEP ;SUBR 1
019 JRST FALSE
020 JRST TRUE
021
022 IFN SFA,[
023 ; PARALLEL TOO AFILEP/XFILEP BUT SKIPS ONCE FOR FILE-OBJECT, AND TWICE
024 ; FOR SFA-OBJECT
025
026 AFOSP: MOVEI AR1,(A)
027 XFOSP: MOVEI R,(AR1)
028 LSH R,-SEGLOG
029 MOVE R,ST(R)
030 TLNN R,SA ;MUST BE A SAR
031 JRST (TT)
032 MOVE R,ASAR(AR1) ;DOES IT HAVE FILE BIT SET?
033 TLNE R,AS<FIL>
034 JRST 1(TT) ;YES, SINGLE SKIP
035 TLNE R,AS.SFA ;AN SFA?
036 JRST 2(TT) ;YES, DOUBLE SKIP
037 JRST (TT) ;ELSE ERROR RETURN
038 ] ;END IFN SFA
FILE OBJECT CHECKING ROUTINES QIO[NEW,LSP] 09/18/78 Page 5
001 ;;; THESE ROUTINES ACCEPT A FILE ARRAY IN AR1 AND CHECK WHETHER
002 ;;; IT IS OF THE DESIRED TYPE. IF NOT, A WTA ERROR OCCURS.
003 ;;; LEAVES TTSAR IN TT AND USER INTS LOCKED IF SUCCESSFUL.
004 ;;; CLOBBERS T, TT, AND R. SAVES D (SEE FILEPOS) AND F.
005
006 005 050 OFILOK: JSP T,FILOK0 ;TYPICAL INVOCATION:
007 TTS<IO>,,TTS<IO> ; DESIRED BITS,,MASK
008 SIXBIT \NOT OUTPUT FILE!\ ; ERROR MSG IF FAIL
009
010 005 050 IFILOK: JSP T,FILOK0
011 0,,TTS<IO>
012 SIXBIT \NOT INPUT FILE!\
013
014 005 050 ATFLOK: JSP T,FILOK0
015 0,,TTS<BN>
016 SIXBIT \NOT ASCII FILE!\
017
018 005 050 ATOFOK: JSP T,FILOK0
019 TTS<IO>,,TTS<BN+IO>
020 SIXBIT \NOT ASCII OUTPUT FILE!\
021
022 005 050 ATIFOK: JSP T,FILOK0
023 0,,TTS<BN+IO>
024 SIXBIT \NOT ASCII INPUT FILE!\
025
026 005 050 TFILOK: JSP T,FILOK0
027 TTS<TY>,,TTS<TY>
028 SIXBIT \NOT TTY FILE!\
029
030 005 050 TIFLOK: JSP T,FILOK0
031 TTS<TY>,,TTS<TY+IO>
032 SIXBIT \NOT TTY INPUT FILE!\
033
034 005 050 TOFLOK: JSP T,FILOK0
035 TTS<TY+IO>,,TTS<TY+IO>
036 SIXBIT \NOT TTY OUTPUT FILE!\
037
038 005 050 XIFLOK: JSP T,FILOK0
039 TTS<BN>,,TTS<IM+BN+IO>
040 SIXBIT \NOT BINARY INPUT FILE!\
041
042 005 050 XOFLOK: JSP T,FILOK0
043 TTS<BN+IO>,,TTS<IM+BN+IO>
044 SIXBIT \NOT BINARY OUTPUT FILE!\
045
046 005 050 FILOK: JSP T,FILOK0
047 0,,0
048 NFILE: SIXBIT \NOT FILE!\
049
050 FILOK0: LOCKI
051 CAIE AR1,TRUTH ;T => TTY FILE ARRAY
052 005 058 JRST FILOK1
053 MOVSI TT,TTS<IO>
FILE OBJECT CHECKING ROUTINES QIO[NEW,LSP] 09/18/78 Page 5.1
054 TSNE TT,(T) ;IF DON'T CARE ABOUT I/O
055 TDNE TT,(T) ; OR SPECIFICALLY WANT OUTPUT
056 SKIPA AR1,V%TYO ; THEN USE TTY OUTPUT
057 HRRZ AR1,V%TYI ;USE TTY INPUT ONLY IF NECESSARY
058 004 008 FILOK1: JSP TT,XFILEP ;SO IS IT A FILE ARRAY?
059 005 069 JRST FILNOK ;NOPE - LOSE
060 MOVE TT,TTSAR(AR1)
061 XOR TT,(T)
062 HLL T,TT
063 MOVE TT,TTSAR(AR1) ;WANT TO RETURN TTSAR IN TT
064 TLNE T,@(T)
065 005 069 JRST FILNOK
066 TLNN TT,TTS<CL>
067 POPJ P, ;YEP - WIN
068 SKIPA TT,[[SIXBIT \FILE HAS BEEN CLOSED!\]]
069 FILNOK: MOVEI TT,1(T)
070 EXCH A,AR1
071 UNLOCKI
072 %WTA (TT)
073 EXCH A,AR1
074 005 050 JRST FILOK0
CONVERSION: NAMELIST => SIXBIT QIO[NEW,LSP] 09/18/78 Page 6
001 SUBTTL CONVERSION: NAMELIST => SIXBIT
002
003 ;;; A NAMELIST IN A IS CONVERTED TO "SIXBIT" FORMAT ON THE FIXNUM PDL.
004 ;;; "SIXBIT" FORMAT IS ACTUALLY SIXBIT FOR SOME OPERATING SYSTEMS,
005 ;;; BUT MAY BE ANY ANY FORM WHATSOEVER AS LONG AS ALL ROUTINES WHICH
006 ;;; CLAIM TO UNDERSTAND "SIXBIT" FORM AGREE ON WHAT THAT FORM IS.
007 ;;; (SOME ROUTINES WHICH DO I/O DEPEND ON THIS FORMAT, FOR EXAMPLE
008 ;;; ITS ROUTINES WHICH USE THE OPEN SYMBOLIC SYSTEM CALL.)
009 ;;; "SIXBIT" FORMAT IS DEFINED AS FOLLOWS:
010 ;;;
011 ;;; FOR ITS: <SIXBIT DEVICE NAME>
012 ;;; <SIXBIT SNAME>
013 ;;; <SIXBIT FILE NAME 1>
014 ;;; <SIXBIT FILE NAME 2> ;TOP OF STACK
015 ;;; AN OMITTED COMPONENT CAN BE REPRESENTED BY EITHER A ZERO
016 ;;; WORD OR SIXBIT \*\ (THE LATTER BEING THE CANONICAL CHOICE).
017 ;;;
018 ;;; FOR DEC10: <SIXBIT DEVICE NAME>
019 ;;; <PROJ-PROG NUMBER>
020 ;;; <SIXBIT FILE NAME>
021 ;;; <SIXBIT EXTENSION> ;TOP OF STACK
022 ;;; AN OMITTED COMPONENT CAN BE REPRESENTED BY EITHER A ZERO
023 ;;; WORD OR SIXBIT \*\ (THE LATTER BEING THE CANONICAL CHOICE),
024 ;;; EXCEPT FOR THE PPN, FOR WHICH 777777 INDICATES AN OMITTED HALFWORD.
025 ;;;
026 ;;; FOR DEC20: <ASCIZ DEVICE OR LOGICAL NAME>
027 ;;; <ASCIZ DIRECTORY NAME>
028 ;;; <ASCIZ FILE NAME>
029 ;;; <ASCIZ EXTENSION/TYPE NAME>
030 ;;; <ASCIZ VERSION/GENERATION> ;TOP OF STACK
031 ;;; THE ENTRIES HERE ARE NOT SINGLE WORDS, BUT ARE OF
032 ;;; RESPECTIVE LENGTHS (IN WORDS) L.6DEV, L.6DIR, L.6FNM,
033 ;;; L.6EXT, L.6VRS.
034 ;;;
035 ;;; NOTE THAT FOR ALL SIXBIT FORMATS THE TOTAL LENGTH OF THE
036 ;;; SIXBIT FORMAT IS L.F6BT. THIS DIVIDES INTO TWO PARTS:
037 ;;; THE DEVICE/DIRECTORY, OF LENGTH L.D6BT, AND THE FILE NAME
038 ;;; PROPER, OF LENGTH L.N6BT.
039 ;;;
040 ;;; THERE ARE FOUR KINDS OF FILE NAME SPECIFICATIONS.
041 ;;; ONE IS A FILE OBJECT, WHICH IMPLIES THE NAME USED TO OPEN IT.
042 ;;; ONE IS AN ATOMIC SYMBOL, WHICH IS TREATED AS A NAMESTRING.
043 ;;; THE OTHER TWO ARE NAMELISTS, UREAD-STYLE AND NEWIO-STYLE.
044 ;;; NEWIO-STYLE NAMELISTS HAVE NON-ATOMIC CARS, WHILE UREAD-STYLE
045 ;;; NAMELISTS HAVE ATOMIC CARS. UREAD-STYLE NAMELISTS ARE MOSTLY
046 ;;; FOR COMPATIBILITY WITH OLDIO, AND FOR USER CONVENIENCE.
047 ;;;
048 ;;; IN A NEWIO-STYLE NAMELIST, THE CAR IS A DEVICE/DIRECTORY
049 ;;; SPECIFICATION, AND THE CDR A FILE NAME SPECIFICATION.
050 ;;; IN PRINCIPLE EACH IS A LIST OF ARBITRARY LENGTH.
051 ;;; IN PRACTICE, THERE IS A LIMIT FOR EACH OF THE PDP-10
052 ;;; IMPLEMENTATIONS. THE CANONICAL NAMELIST FORMAT FOR
053 ;;; EACH SYSTEM IS AS FOLLOWS:
CONVERSION: NAMELIST => SIXBIT QIO[NEW,LSP] 09/18/78 Page 6.1
054 ;;; ITS: ((<DEVICE> <SNAME>) <FILE NAME 1> <FILE NAME 2>)
055 ;;; TOPS10: ((<DEVICE> (<PROJ#> <PROG#>)) <FILE NAME> <EXTENSION>)
056 ;;; SAIL: ((<DEVICE> (<PROJ> <PROG>)) <FILE NAME> <EXTENSION>)
057 ;;; CMU: ((<DEVICE> <PPN>) <FILE NAME> <EXTENSION>)
058 ;;; CMU ALSO ALLOWS TOPS10-STYLE NAMELISTS.
059 ;;; TENEX: ((<DEVICE> <DIRECTORY>) <FILE NAME> <EXTENSION> <VERSION>)
060 ;;; TOPS20: ((<DEVICE> <DIRECTORY>) <FILE NAME> <TYPE> <GENERATION>)
061 ;;;
062 ;;; ALL COMPONENTS ARE NOMINALLY ATOMIC SYMBOLS, EXCEPT <PROJ#> AND <PROG#>,
063 ;;; WHICH ARE FIXNUMS. IF THE USER SUPPLIES A COMPONENT WHICH IS NOT
064 ;;; A SYMBOL (AND IT CAN EVEN BE NON-ATOMIC IF THERE IS NO AMBIGUITY
065 ;;; AS TO FORMAT), THEN IT IS EXPLODEC'D WITH BASE=10., PRINLEVEL=PRINLENGTH=NIL,
066 ;;; AND *NOPOINT=T. A COMPONENT MAY BE "OMITTED" BY USING THE ATOMIC
067 ;;; SYMBOL *. THIS DOES NOT MEAN A WILDCARD, BUT ONLY AN OMITTED COMPONENT.
068 ;;;
069 ;;; IF THE USER SUPPLIES A NAMELIST NOT IN CANONICAL FORM, THE CAR AND CDR
070 ;;; ARE INDEPENDENTLY CANONICALIZED. THE CAR CAN BE ACANONICAL ONLY BY
071 ;;; BEING A SINGLETON LIST; IN THIS CASE AN ATTEMPT IS MADE TO DECIDE
072 ;;; WHETHER IT IS A DEVICE OR DIRECTORY SPECIFICATION. THIS IS DONE IN
073 ;;; DIFFERENT WAYS ON DIFFERENT SYSTEMS. ON TOPS10, FOR EXAMPLE, AN ATOMIC
074 ;;; SPECIFICATION IS NECESSARY A DEVICE AND NOT A PPN. ON THE OTHER HAND,
075 ;;; ON ITS A LIST OF STANDARD DEVICE NAMES IS CHECKED.
076 ;;; THE CDR CAN BE ACANONICAL BY BEING TOO SHORT, OR BY BEING A DOTTED LIST,
077 ;;; OR BOTH. COMPONENTS ARE TAKEN IN ORDER UNTIL AN ATOMIC CDR IS REACHED.
078 ;;; IF THIS CDR IS NIL, ALL REMAINING COMPONENTS ARE TAKEN TO BE *.
079 ;;; OTHERWISE, ALL REMAINING COMPONENTS ARE * EXCEPT THE LAST, WHICH IS
080 ;;; THAT ATOM IN THE CDR.
081 ;;;
082 ;;; A UREAD-STYLE NAMELIST IS NOMINALLY IN THE FORM (A B C D), WHERE
083 ;;; A, AT LEAST, MUST BE ATOMIC. IT IS INTERPRETED AS IF IT WERE CONVERTED
084 ;;; TO THE FORM ((C D) A B) [DEC20: ((C D) A * B)], AND THEN TREATING IT AS
085 ;;; AN ORDINARY NAMELIST. (IF C AND D ARE MISSING, THEN (*) IS USED INSTEAD
086 ;;; OF NIL AS THE CAR OF THE CONSTRUCTED NAMELIST.
087
088 011 046 NML6BT: JSP T,QIOSAV ;SAVE REGISTERS
089 NML6B5: PUSH P,A
090 HLRZ A,(A) ;CHECK CAR OF NAMELIST
091 JSP T,STENT
092 006 104 JUMPGE TT,NML6B2 ;JUMP IF UREAD-STYLE NAMELIST
093 006 199 PUSHJ P,NML6DV ;CONVERT DEVICE/DIRECTORY SPECIFICATION
094 006 099 JRST NML6B0 ;SKIPS UNLESS CONVERSION FAILED
095 HRRZ A,@(P)
096 006 133 PUSHJ P,NML6FN ;CONVERT FILE NAMES (LEAVES TAIL IN A)
097 JUMPE A,POP1J ;SUCCEED UNLESS TOO MANY FILE NAMES
098 NML6BZ: POPI FXP,L.N6BT ;POP FILE NAME CRUD
099 NML6B0: POPI FXP,L.D6BT ;POP DEVICE/DIRECTORY CRUD
100 POP P,A ;POP ORIGINAL ARGUMENT
101 007 009 WTA [INCORRECTLY FORMED NAMELIST!]
102 006 089 JRST NML6B5
103
104 NML6B2: HRRZ A,(P) ;HERE FOR UREAD-STYLE NAMELIST
105 006 135 PUSHJ P,NML6UF ;CONVERT FILE NAMES, BUT AT MOST TWO OF THEM
106 006 199 PUSHJ P,NML6DV ;NOW CONVERT THE DEVICE/DIRECTORY
CONVERSION: NAMELIST => SIXBIT QIO[NEW,LSP] 09/18/78 Page 6.2
107 006 098 JRST NML6BZ ;NOTE THAT POPI'S COMMUTE AT NML6BZ!
108 ;AT THIS POINT THE WORDS ON FXP ARE IN THE WRONG ORDER, SO WE SHUFFLE THE STACK.
109 IFN ITS+D10,[
110 POP FXP,TT ;DIRECTORY
111 POP FXP,T ;DEVICE
112 EXCH T,-1(FXP) ;EXCH DEVICE WITH FN1
113 EXCH TT,(FXP) ;EXCH DIR WITH FN2
114 PUSH FXP,T ;PUSH FN1
115 PUSH FXP,TT ;PUSH FN2
116 ] ;END OF IFN ITS+D10
117 IFN D20,[
118 MOVEI T,-L.F6BT+1(FXP)
119 HRLI T,-L.N6BT
120 PUSH FXP,(T) ;COPY THE FILE NAMES TO THE TOP
121 AOBJN T,.-1 ; OF THE STACK
122 MOVEI T,-L.F6BT-L.N6BT+1(FXP)
123 HRLI T,-L.F6BT+1(FXP)
124 BLT T,-L.N6BT(FXP) ;COPY ENTIRE "SIXBIT" SET DOWNWARD
125 POPI FXP,L.N6BT ;POP OFF EXTRANEOUS CRUD
126 ] ;END OF IFN D20
127 JRST POP1J
128
129 ;;; CONVERT FILE NAME LIST IN A TO "SIXBIT" FORM ON FXP.
130 ;;; RETURNS THE UNUSED TAIL OF THE LIST IN A.
131 ;;; NML6UF IS LIKE NML6FN, BUT NEVER GOBBLES MORE THAN TWO NAMES.
132
133 NML6FN:
134 20$ TDZA T,T
135 NML6UF:
136 20$ SETO T, ;UREAD-STYLE DISTINCTION ONLY MATTERS TO DEC20
137 20$ HRLM T,(P)
138 20$ PUSHN FXP,L.N6BT ;PUSH ROOM FOR THE FILE NAMES
139 20% REPEAT 2, PUSH FXP,[SIXBIT \*\] ;PUSH ROOM FOR THE FILE NAMES
140 JUMPE A,CPOPJ ;NULL LIST => ALL NAMES OMITTED
141 PUSH P,A
142 JSP T,STENT
143 006 192 JUMPGE TT,NML6F3 ;ATOM MEANS LAST COMPONENT
144 HLRZ A,(A)
145 20% PUSHJ P,SIXMAK ;CONVERT FIRST COMPONENT TO SIXBIT,
146 20% MOVEM TT,-1(FXP) ; AND CALL IT FILE NAME 1
147 IFN D20,[
148 PUSHJ P,PNBFMK ;CONVERT FIRST COMPONENT TO ASCIZ,
149 MOVEI T,-L.6FNM-L.6EXT-L.6VRS+1(FXP) ; AND CALL IT THE FILE NAME
150 HRLI T,PNBUF
151 BLT T,-L.6EXT-L.6VRS(FXP)
152 DPB NIL,[010700,,-L.6EXT-L.6VRS(FXP)] ;MAKE SURE LAST BYTE IS NULL
153 ] ;END OF IFN D20
154 HRRZ A,@(P)
155 JUMPE A,POP1J ;EXIT IF ALL DONE
156 MOVEM A,(P)
157 IFN D20,[
158 JSP T,STENT
159 006 192 JUMPGE TT,NML6F3 ;ATOM MEANS LAST COMPONENT
CONVERSION: NAMELIST => SIXBIT QIO[NEW,LSP] 09/18/78 Page 6.3
160 HLRZ A,(A)
161 PUSHJ P,PNBFMK ;CONVERT NEXT COMPONENT TO ASCIZ,
162 MOVEI T,-L.6EXT-L.6VRS+1(FXP) ; AND CALL IT THE EXTENSION
163 HRLI T,PNBUF
164 BLT T,-L.6VRS(FXP)
165 DPB NIL,[010700,,-L.6VRS(FXP)] ;MAKE SURE LAST BYTE IS NULL
166 HRRZ A,@(P)
167 JUMPE A,POP1J ;EXIT IF ALL DONE
168 SKIPGE -1(P) ;FOR UREAD-STYLE NAMELISTS, READ AT MOST
169 006 189 JRST NML6F4 ; TWO COMPONENTS
170 MOVEM A,(P)
171 NML6F5:
172 ] ;END OF IFN D20
173 JSP T,STENT
174 006 192 JUMPGE TT,NML6F3 ;ATOM MEANS LAST COMPONENT
175 HLRZ A,(A)
176 NML6F2:
177 IFE D20,[
178 PUSHJ P,SIXMAK ;CONVERT LAST COMPONENT TO SIXBIT,
179 10$ TRZ TT,-1 ; TRUNCATING TO 3 CHARS FOR DEC10,
180 MOVEM TT,(FXP) ; AND CALL IT FILE NAME 2
181 ] ;END OF IFN D20
182 IFN D20,[
183 PUSHJ P,PNBFMK ;CONVERT LAST COMPONENT TO ASCIZ,
184 MOVEI T,-L.6VRS+1(FXP) ; AND CALL IT THE VERSION
185 HRLI T,PNBUF
186 BLT T,(FXP)
187 DPB NIL,[010700,,(FXP)] ;MAKE SURE LAST BYTE IS NULL
188 ] ;END OF IFN D20
189 NML6F4: HRRZ A,@(P)
190 JRST POP1J
191
192 NML6F3: SETZM (P)
193 006 176 20% JRST NML6F2
194 006 189 20$ JRST NML6F4
195
196 ;;; CONVERTS A DEVICE/DIRECTORY SPECIFICATION IN A TO "SIXBIT" FORM ON FXP.
197 ;;; PERFORMS DEVICE/DIRECTORY DISAMBIGUATION. SKIPS ON SUCCESS.
198
199 NML6DV:
200 IT$ REPEAT 2, PUSH FXP,[SIXBIT \*\] ;PUSH ROOM FOR DEV/DIR CRUD
201 10$ PUSH FXP,[SIXBIT \*\]
202 10$ PUSH FXP,[-1]
203 20$ PUSHN FXP,L.D6BT ;PUSH ROOM FOR DEV/DIR CRUD
204 JUMPE A,POPJ1 ;NULL SPEC => DEFAULTS
205 HRRZ B,(A)
206 HLRZ A,(A)
207 PUSH P,B
208 IFN D10,[
209 JSP T,STENT ;FOR D10, A NON-ATOMIC ITEM MUST BE A PPN
210 006 252 JUMPL TT,NML6D7
211 ] ;END OF D10
212 20% PUSHJ P,SIXMAK
CONVERSION: NAMELIST => SIXBIT QIO[NEW,LSP] 09/18/78 Page 6.4
213 20$ PUSHJ P,PNBFMK
214 IFN ITS+D20+CMU,[
215 SKIPE (P) ;FOR ONLY ONE ITEM, IT COULD BE EITHER
216 006 222 JRST NML6D1 ; DEVICE OR DIRECTORY
217 006 321 PUSHJ P,IDND ;DISAMBIGUATE THIS MESS
218 006 290 IFN ITS+D20 JRST NML6D4 ;JUMP IF A DIRECTORY NAME
219 006 243 CMU$ JRST NML6D8
220 ] ;END OF IFN ITS+D20+CMU
221 ;FOR TOPS10 AND SAIL, AN ATOMIC ITEM MUST BE A DEVICE NAME (NOT TRUE OF CMU, THOUGH)
222 NML6D1:
223 20% MOVEM TT,-1(FXP) ;IT'S DEFINITELY A DEVICE NAME
224 IFN D20,[
225 MOVEI T,-L.6DEV-L.6DIR+1(FXP)
226 HRLI T,PNBUF
227 BLT T,-L.6DIR+1(FXP)
228 DPB NIL,[010700,,-L.6DIR(FXP)]
229 ] ;END OF IFN D20
230 SKIPN (P)
231 JRST POP1J1 ;SUCCESS IF NO DIRECTORY SPEC
232 HLRZ A,@(P)
233 HRRZ B,@(P)
234 MOVEM B,(P)
235 ;HERE IS WHERE IT HITS THE FAN - NO TWO SYSTEMS HAVE THE SAME DIRECTORY SPEC FORMAT!
236 IFN ITS, PUSHJ P,SIXMAK ;FOR ITS IT IS A PLAIN SIXBIT NAME
237 IFN D20, PUSHJ P,PNBFMK ;FOR D20 IT IS ASCII
238 IFN D10,[
239 JSP T,STENT
240 IFN TOPS10+SAIL, JUMPGE TT,POP1J ;AN ATOMIC DIRECTORY IS ILLEGAL FOR TOPS10/SAIL
241 IFN CMU,[
242 006 252 JUMPL TT,NML6D7 ;FOR CMU, NON-ATOMIC => TOPS10-STYLE
243 NML6D8: SETO TT,
244 CAIN A,Q. ;* AS A PPN STRING IS TAKEN TO MEAN (* *)
245 006 290 JRST NML6D4
246 PUSHJ P,PNBFMK
247 MOVEI TT,PNBUF ;0,,ADDRESS OF CMU PPN STRING
248 CMUDEC TT, ;CMUDEC WILL CONVERT A STRING TO A PPN WORD
249 JRST POP1J ;FAIL IF NOT A VALID CMU PPN
250 006 290 JRST NML6D4
251 ] ;END OF IFN CMU
252 NML6D7: HLRZ B,(A) ;B GETS PROJECT
253 HRRZ C,(A)
254 HLRZ A,(C) ;A GETS PROGRAMMER
255 HRRZ C,(C)
256 JUMPN C,POP1J ;FAIL IF THREE ITEMS IN THE PPN SPEC
257 IFN TOPS10+CMU,[
258 CAIN B,Q. ;* MEANS AN OMITTED COMPONENT
259 SKIPA D,[,,-1]
260 JSP T,FXNV2 ;OTHERWISE EXPECT A FIXNUM
261 CAIN A,Q.
262 SKIPA TT,[,,-1]
263 JSP T,FXNV1
264 TLNN TT,-1
265 TLNE D,-1
CONVERSION: NAMELIST => SIXBIT QIO[NEW,LSP] 09/18/78 Page 6.5
266 JRST POP1J ;NUMBERS MUST FIT INTO HALFWORDS
267 HRLI TT,(D)
268 ] ;END OF IFN TOPS10+CMU
269 IFN SAIL,[
270 PUSH P,B
271 CAIN A,Q. ;* MEANS AN OMITTED COMPONENT
272 SKIPA TT,[0,,-1]
273 PUSHJ P,SIXMAK ;OTHERWISE GET SIXBIT
274 006 304 PUSHJ P,SARGHT ;RIGHT JUSTIFY IT
275 PUSH FXP,TT
276 POP P,A
277 CAIN A,Q. ;* MEANS AN OMITTED COMPONENT
278 SKIPA TT,[0,,-1]
279 PUSHJ P,SIXMAK ;OTHERWISE GET SIXBIT
280 006 304 PUSHJ P,SARGHT ;RIGHT JUSTIFY IT
281 POP FXP,D
282 TLNN TT,-1
283 TLNE D,-1
284 JRST POP1J ;NO MORE THAN 3 CHARS APIECE
285 MOVSS TT
286 HRRI TT,(D)
287 ] ;END OF IFN SAIL
288 ] ;END OF IFN D10
289 ;NOW WE HAVE THE SNAME/PPN IN TT FOR ITS/D10, OR DIRECTORY IN PNBUF FOR D20
290 NML6D4:
291 20% MOVEM TT,(FXP)
292 IFN D20,[
293 MOVEI T,-L.6DIR+1(FXP)
294 HRLI T,PNBUF
295 BLT T,(FXP)
296 DPB NIL,[010700,,(FXP)]
297 ] ;END OF IFN D20
298 SKIPN (P) ;WE WIN IFF THERE ARE NO MORE ITEMS TO PARSE
299 AOS -1(P)
300 JRST POP1J
301
302 IFN SAIL,[
303 ;RIGHT JUSTIFY SIXBIT WORD IN TT
304 SARGHT: SKIPE TT ;IF NOTHING THERE WE DON'T WANT TO LOOP
305 TRNE TT,77 ;ANYTHING IN HIGH SIXBIT BYTE?
306 POPJ P, ;YUP, IT IS THEREFORE LEFT-JUSTIFIED
307 LSH TT,-6 ;ELSE GET RID OF THE LEADING BLANK
308 006 304 JRST SARGHT ;AND PROCEED WITH TEST
309 ] ;END IFN SAIL
310
311 IFN ITS+CMU+D20,[
312 ;;; INSUFFERABLE DEVICE NAME DISTINGUISHER
313 ;;; A NAME IS IN TT IN SIXBIT (ITS/CMU) OR IN PNBUF IN ASCII (D20).
314 ;;; TRIES TO DECIDE WHETHER A NAME IS A DEVICE NAME OR A DIRECTORY NAME.
315 ;;; FOR ITS, IT IS A DEVICE NAME IFF, AFTER STRIPPING OFF TRAILING DIGITS,
316 ;;; IT IS IN THE TABLE OF KNOWN DEVICE NAMES.
317 ;;; FOR CMU, WE USE THE DEVCHR UUO TO TEST EXISTENCE.
318 ;;; FOR D20, WE USE THE STDEV JSYS TO TEST EXISTENCE.
CONVERSION: NAMELIST => SIXBIT QIO[NEW,LSP] 09/18/78 Page 6.6
319 ;;; SKIPS IF A DEVICE NAME. MUST PRESERVE A AND TT.
320
321 IDND:
322 IFN CMU,[
323 MOVE F,TT
324 DEVCHR F, ;FOR CMU, GET CHARACTERISTICS OF DEVICE
325 JUMPE F,CPOPJ ;ZERO WORD MEANS DEVICE DOESN'T EXIST
326 JRST POPJ1
327 ] ;END OF IFN CMU
328 IFN D20,[
329 PUSH P,A
330 LOCKI ;LOCK OUT INTERRUPTS AROUND THE JSYS
331 HRROI A,PNBUF
332 STDEV ;CONVERT DEVICE STRING TO DEVICE DESIGNATOR
333 CAIA ;ERROR - NO SUCH DEVICE
334 AOS -1(P) ;IF DEVICE, SKIP RETURN FOR STDEV AND US TOO
335 POP P,A
336 UNLKPOPJ
337 ] ;END OF IFN D20
338 IFN ITS,[
339 MOVE F,TT
340 MOVE R,[000600,,TT]
341 ;R NOW HAS A BYTE POINTER TO THE END OF THE NAME; WE WILL STRIP DIGITS.
342 SETZ T,
343 IDND1: LDB B,R ;GET CHARACTER FROM END
344 CAIL B,'0
345 CAILE B,'9
346 006 353 JRST IDND3 ;NOT A DIGIT
347 DPB NIL,R ;STRIP OFF DIGIT
348 ADD R,[060000,,] ;DECREMENT BYTE POINTER
349 SKIPGE R
350 SUB R,[440000,,1]
351 006 343 JRST IDND1
352
353 006 360 IDND3: MOVE R,[-LIDNTB,,IDNTB]
354 CAME TT,(R)
355 AOBJN R,.-1
356 MOVE TT,F ;RESTORE TT
357 JUMPGE R,CPOPJ ;NOT IN TABLE - MUST BE A DIRECTORY
358 JRST POPJ1 ;IT'S A DEVICE - SKIP RETURN
359
360 IDNTB:
361 IRP X,,[DSK,SYS,TTY,AI,MC,ML,DM,COM,T,TY,STY,ST,S,PK,P,DK,UT,MT
362 NUL,ARC,AR,DIR,AIDIR,MCDIR,MLDIR,DMDIR,TPL,CLO,CLU,CLI,CLA
363 USR,DIS,JOB,BOJ,OJB,ERR,SPY,COR,LPT,PTP,PTR]
364 SIXBIT \X\
365 TERMIN
366 006 360 LIDNTB==:.-IDNTB
367 ] ;END OF IFN ITS
368
369 ] ;END OF IFN ITS+CMU+D20
CONVERSION: SIXBIT => NAMELIST QIO[NEW,LSP] 09/18/78 Page 7
001 SUBTTL CONVERSION: SIXBIT => NAMELIST
002
003 ;;; THIS ROUTINE TAKES "SIXBIT" FORMAT ON FXP AND,
004 ;;; POPPING THEM, RETURNS THE EQUIVALENT CANONICAL NAMELIST.
005 ;;; OMITTED COMPONENTS BECOME *'S.
006 ;;; THE NAMELIST FUNCTION MERELY CONVERTS ARG TO SIXBIT,
007 ;;; THEN BACK TO (CANONICAL) NAMELIST FORM.
008
009 NAMELIST:
010 011 018 PUSHJ P,FIL6BT ;SUBR 1
011 011 046 6BTNML: JSP T,QIOSAV ;MUST ALSO PRESERVE F
012 PUSHN P,1
013 ;FOR D20, POP THE VERSION (TENEX)/GENERATION (TOPS20) AND CONS IT UP
014 IFN D20,[
015 REPEAT L.6VRS, POP FXP,PNBUF+L.6VRS-.RPCNT-1
016 PUSHJ P,6BTNL3
017 ] ;END OF IFN D20
018 ;POP THE FILE NAME 2 (ITS)/EXTENSION (D10, TENEX)/TYPE (TOPS20) AND CONS UP
019 IFN ITS+D10, POP FXP,TT
020 IFN D10, TRZ TT,-1 ;D10 EXTENSION IS AT MOST 3 CHARACTERS
021 IFN D20,[
022 MOVEI T,PNBUF
023 HRLI T,-L.6EXT+1(FXP)
024 BLT T,PNBUF+L.6EXT-1
025 POPI FXP,L.6EXT
026 ] ;END OF IFN D20
027 PUSHJ P,6BTNL3
028 ;POP THE FILE NAME 1 (ITS)/FILE NAME (D10, D20) AND CONS UP
029 IFN ITS+D10, POP FXP,TT
030 IFN D20,[
031 MOVEI T,PNBUF
032 HRLI T,-L.6FNM+1(FXP)
033 BLT T,PNBUF+L.6FNM-1
034 POPI FXP,L.6FNM
035 ] ;END OF IFN D20
036 PUSHJ P,6BTNL3
037 ;NOW FOR THE DEVICE/DIRECTORY PORTION
038 PUSHN P,1
039 ;FIRST THE DIRECTORY (WHAT A MESS!)
040 IFN ITS,[
041 POP FXP,TT
042 PUSHJ P,6BTNL3
043 ] ;END OF IFN ITS
044 IFN D10,[
045 POP FXP,TT
046 PUSHJ P,PPNATM
047 PUSHJ P,6BTNL4
048 ] ;END OF IFN D10
049 IFN D20,[
050 MOVEI T,PNBUF
051 HRLI T,-L.6DIR+1(FXP)
052 BLT T,PNBUF+L.6DIR-1
053 POPI FXP,L.6DIR
CONVERSION: SIXBIT => NAMELIST QIO[NEW,LSP] 09/18/78 Page 7.1
054 PUSHJ P,6BTNL3
055 ] ;END OF IFN D20
056 ;FINALLY, THE DEVICE NAME
057 20% POP FXP,TT
058 IFN D20,[
059 MOVEI T,PNBUF
060 HRLI T,-L.6DEV+1(FXP)
061 BLT T,PNBUF+L.6DEV-1
062 POPI FXP,L.6DEV
063 ] ;END OF IFN D20
064 PUSHJ P,6BTNL3
065 POP P,A
066 POP P,B
067 JRST CONS
068
069 SA$ 6BTNL9: SKIPA A,[Q.]
070 6BTNL3:
071 20% PUSHJ P,SIXATM
072 20$ PUSHJ P,PNBFAT
073 6BTNL4: MOVE B,-1(P)
074 PUSHJ P,CONS
075 MOVEM A,-1(P)
076 POPJ P,
CONVERSION: SIXBIT => NAMESTRING QIO[NEW,LSP] 09/18/78 Page 8
001 SUBTTL CONVERSION: SIXBIT => NAMESTRING
002
003 ;;; THIS ROUTINE TAKES A "SIXBIT" FORMAT FILE SPEC ON FXP
004 ;;; AND GENERATES AN UNINTERNED ATOMIC SYMBOL WHOSE
005 ;;; PRINT NAME IS THE EXTERNAL FORM OF FILE SPECIFICATION.
006 ;;; OMITTED NAMES ARE EITHER NOT INCLUDED IN THE NAMESTRING
007 ;;; OR REPRESENTED AS "*".
008 ;;; THE NAMESTRING AND SHORTNAMESTRING MERELY CONVERT THEIR
009 ;;; ARGUMENTS TO SIXBIT AND THEN INTO NAMESTRING FORM.
010
011 SHORTNAMESTRING: ;SUBR 1
012 TDZA TT,TT
013 NAMESTRING: ;SUBR 1
014 SETO TT,
015 HRLM TT,(P)
016 011 018 PUSHJ P,FIL6BT
017 6BTNMS: PUSHJ P,6BTNS ;TO MAKE A NAMESTRING, GET IT INTO PNBUF
018 JRST PNGNK2 ; AND THEN PNGNK2 WILL MAKE A SYMBOL
019
020 IFN D20,[
021 X6BTNS: MOVEI T,L.F6BT ;MAKES A STRING IN PNBUF WITHOUT REALLY
022 PUSH FXP,-L.F6BT+1(FXP) ; POPPING THE FILE NAMES (WE COPY THEM FIRST)
023 SOJG T,.-1
024 ] ;END OF IFN D20
025 011 046 6BTNS: JSP T,QIOSAV ;CONVERT "SIXBIT" TO A STRING IN PNBUF
026 ; (BETTER BE BIG ENOUGH!)
027 SETOM LPNF ;SET FLAG SAYING IT FITS IN PNBUF
028 20% MOVEI R,↑Q ;R CONTAINS THE CHARACTER FOR QUOTING
029 20$ MOVEI R,↑V ; PECULIAR CHARACTERS IN COMPONENTS
030 MOVE C,PNBP
031 SKIPL -6(P) ;SKIP UNLESS SHORTNAMESTRING
032 JRST 6BTNS0
033 ;DEVICE NAME (NOT FOR SHORTNAMESTRING, THOUGH)
034 IFN ITS+D10,[
035 SKIPE TT,-3(FXP)
036 CAMN TT,[SIXBIT \*\]
037 JRST 6BNS0A ;JUMP IF DEVICE NAME OMITTED
038 ] ;END OF IFN ITS+D10
039 IFN D20,[
040 SKIPN -L.6DEV-L.6DIR-L.6FNM-L.6EXT-L.6VRS+1(FXP)
041 JRST 6BNS0A ;JUMP IF DEVICE NAME OMITTED
042 MOVEI TT,-L.6DEV-L.6DIR-L.6FNM-L.6EXT-L.6VRS+1(FXP)
043 ] ;END OF IFN D20
044 PUSHJ P,6BTNS1
045 MOVEI TT,": ;9 OUT OF 10 OPERATING SYSTEMS AGREE:
046 IDPB TT,C ; ":" MEANS A DEVICE NAME.
047 6BNS0A:
048 ;FOR ITS AND D20, DIRECTORY NAME COMES NEXT
049 IFN ITS,[
050 SKIPE TT,-2(FXP)
051 CAMN TT,[SIXBIT \*\]
052 JRST 6BTNS0 ;DIRECTORY NAME OMITTED
053 PUSHJ P,6BTNS1
CONVERSION: SIXBIT => NAMESTRING QIO[NEW,LSP] 09/18/78 Page 8.1
054 MOVEI TT,"; ;";" MEANS DIRECTORY NAME TO ITS
055 IDPB TT,C
056 ] ;END OF IFN ITS
057 IFN D20,[
058 SKIPN -L.6DIR-L.6FNM-L.6EXT-L.6VRS+1(FXP)
059 JRST 6BTNS0 ;DIRECTORY NAME OMITTED
060 MOVEI TT,"< ;D20 DIRECTORY NAME APPEARS IN <>
061 IDPB TT,C
062 MOVEI TT,-L.6DIR-L.6FNM-L.6EXT-L.6VRS+1(FXP)
063 PUSHJ P,6BTNS1
064 MOVEI TT,">
065 IDPB TT,C
066 ] ;END OF IFN D20
067 6BTNS0:
068 ;NOW WE ATTACK THE FILE NAME
069 20% MOVE TT,-1(FXP)
070 20$ MOVEI TT,-L.6FNM-L.6EXT-L.6VRS+1(FXP)
071 PUSHJ P,6BTNS1
072 ;NOW THE FILE NAME 2/EXTENSION/TYPE
073 IFN ITS, MOVEI TT,40
074 IFN D10+D20, MOVEI TT,".
075 10$ SKIPE (FXP)
076 IDPB TT,C
077 IT$ MOVE TT,(FXP)
078 10$ HLLZ TT,(FXP)
079 20$ MOVEI TT,-L.6EXT-L.6VRS+1(FXP)
080 IT% SKIPE TT
081 PUSHJ P,6BTNS1
082 IFN D20,[
083 ;FOR D20, THE VERSION/GENERATION COMES LAST
084 WARN [HOW TO DISTINGUISH NULL VERSION FROM *?]
085 SKIPN -L.6VRS+1(FXP)
086 JRST 6BTNS8
087 10X MOVEI TT,";
088 20X MOVEI TT,".
089 IDPB TT,C
090 MOVEI TT,-L.6VRS+1(FXP)
091 PUSHJ P,6BTNS1
092 ] ;END OF IFN D20
093 IFN D10,[
094 ;FOR D10, THE DIRECTORY COMES LAST
095 MOVE TT,-2(FXP)
096 CAME T,XC-1 ;FORGET IT IF BOTH HALVES OMITTED
097 SKIPL (P) ;NO DIRECTORY FOR SHORTNAMESTRING
098 JRST 6BTNS8
099 MOVEI TT,133 ;A LEFT BRACKET
100 IDPB TT,C
101 IFN CMU,[
102 HLRZ T,-2(FXP)
103 CAIG T,10 ;ONLY PROJECTS ABOVE 10 ARE IN CMU FORMAT
104 JRST 6BTNS4
105 PUSHN FXP,2 ;THERE IS A BUG IN DECCMU, BUT PUSHING ZERO WORDS
106 MOVEI T,-1(FXP) ; GETS US AROUND IT
CONVERSION: SIXBIT => NAMESTRING QIO[NEW,LSP] 09/18/78 Page 8.2
107 HRLI T,-4(FXP)
108 DECCMU T,
109 JRST 6BTNS4 ;ON FAILURE, JUST USE DEC FORMAT
110 MOVEI T,-1(FXP)
111 TLOA T,440700
112 6BNS4A: IDPB TT,C ;COPY CHARACTERS INTO PNBUF
113 ILDB TT,T
114 JUMPN TT,6BNS4A
115 POPI FXP,2
116 JRST 6BTNS5
117 6BTNS4:
118 ] ;END OF IFN CMU
119 HLLZ TT,-2(FXP)
120 PUSHJ P,6BTNS6 ;OUTPUT PROJECT
121 MOVEI TT,", ;COMMA SEPARATES HALVES
122 IDPB TT,C
123 HRLZ TT,-2(FXP)
124 PUSHJ P,6BTNS6 ;OUTPUT PROGRAMMER
125 6BTNS5: MOVEI TT,135 ;A RIGHT BRACKET
126 IDPB TT,C
127 ] ;END OF IFN D10
128 6BTNS8: PUSHJ FXP,RDAEND ;FINISH OFF THE LAST WORD OF THE STRING
129 SETZM 1(C)
130 POPI FXP,L.F6BT ;POP CRUD OFF STACK
131 MOVEM C,-3(P) ;CROCK DUE TO SAVED AC C
132 POPJ P,
133
134 ;;; COME HERE TO ADD A COMPONENT TO THE GROWING NAMESTRING IN PNBUF.
135 ;;; FOR ITS AND D10, THE SIXBIT IS IN TT, AND MUST BE CONVERTED.
136 ;;; FOR DEC20, TT HAS A POINTER TO THE ASCIZ STRING TO ADD.
137
138 6BTNS1:
139 IFN ITS+D10,[
140 SKIPN TT ;A ZERO WORD GETS OUTPUT AS "*"
141 MOVSI TT,(SIXBIT \*\)
142 6BTNS2: SETZ T,
143 LSHC T,6
144 JUMPE T,6BTNS3
145 10$ CAIE T,133-40 ;FOR DEC-10, BRACKETS MUST
146 10$ CAIN T,135-40 ; BE QUOTED
147 10$ JRST 6BTNS3
148 CAIE T,':
149 10% CAIN T,';
150 10$ CAIN T,'.
151 6BTNS3: IDPB R,C ;↑Q TO QUOTE FUNNY CHARS
152 ADDI T,40
153 IDPB T,C
154 JUMPN TT,6BTNS2
155 POPJ P,
156 ] ;END OF IFN ITS+D10
157 IFN D20,[
158 SETZ D,
159 HRLI TT,440700
CONVERSION: SIXBIT => NAMESTRING QIO[NEW,LSP] 09/18/78 Page 8.3
160 6BTNS2: ILDB T,TT
161 JUMPE T,CPOPJ
162 TRZE D,1 ;D IS THE PRECEDING-CHAR-WAS-↑V FLAG
163 JRST 6BTNS3
164 IRPC X,,[:;<>=←*@ ,] ;EVEN NUMBER OF GOODIES!
165 IFE .IRPCNT&1, CAIE T,"X
166 .ELSE,[
167 CAIN T,"X
168 IDPB R,C ;QUOTE FUNNY CHARACTER
169 ] ;END OF .ELSE
170 TERMIN
171 IFN TOPS20,[ ;TOPS20 REQUIRES ADDITONAL CHARACTERS TO BE QUOTED
172 IRPC X,,[()[]{}/!"#%&'\|`↑}]
173 IFE .IRPCNT&1, CAIE T,"X
174 .ELSE,[
175 CAIN T,"X
176 IDPB R,C ;QUOTE FUNNY CHARACTER
177 ] ;END OF .ELSE
178 TERMIN
179 ] ;END OF IFN TOPS20
180 CAIN T,(R)
181 TRO D,1
182 6BTNS3: IDPB T,C
183 JRST 6BTNS2
184 ] ;END OF IFN D20
185
186 IFN D10,[
187 ;;; CONVERT ONE HALF OF A PPN, PUTTING ASCII CHARS IN PNBUF
188
189 6BTNS6: JUMPE TT,6BNS6A
190 CAME TT,[-1,,]
191 AOJA TT,6BTNS7 ;ADDING ONE PRODUCES A FLAG BIT
192 6BNS6A: MOVEI TT,"* ;AN OMITTED HALF IS OUTPUT AS "*"
193 IDPB TT,C
194 POPJ P,
195
196 6BNS7A: LSH TT,3+3*SAIL ;ZERO-SUPPRESS OCTAL (TOPS10/CMU), LEFT-JUSTIFY CHARS (SAIL)
197 6BTNS7: TLNN TT,770000←<3*<1-SAIL>>
198 JRST 6BNS7A ;NOTE THAT THE FLAG BIT GETS SHIFTED TOO
199 6BNS7B: SETZ T,
200 LSHC T,3+3*SAIL
201 SA% ADDI T,"0
202 SA$ ADDI T,40
203 IDPB T,C
204 TRNE TT,-1 ;WE'RE DONE WHEN THE FLAG BIT LEAVES THE RIGHT HALF
205 JRST 6BNS7B
206 POPJ P,
207
208 ] ;END OF IFN D10
CONVERSION: NAMESTRING => SIXBIT QIO[NEW,LSP] 09/18/78 Page 9
001 SUBTTL CONVERSION: NAMESTRING => SIXBIT
002
003 ;;; THIS ONE IS PRETTY HAIRY. IT CONVERTS AN ATOMIC
004 ;;; SYMBOL IN A, REPRESENTING A FILE SPECIFICATION,
005 ;;; INTO "SIXBIT" FORMAT ON FXP. THIS INVOLVES
006 ;;; PARSING A FILE NAME IN STANDARD ASCII STRING FORMAT
007 ;;; AS DEFINED BY THE HOST OPERATING SYSTEM.
008 ;;; FOR D20, THE OPERATING SYSTEM GIVES US SOME HELP.
009 ;;; FOR ITS AND D10, WE ARE ON OUR OWN.
010
011 IFN ITS+D10,[
012
013 ;;; THE GENERAL STRATEGY HERE IS TO CALL PRINTA TO EXPLODEC THE NAMESTRING.
014 ;;; A PARSING COROUTINE TAKES THE SUCCESSIVE CHARACTERS AND INTERPRETS THEM.
015 ;;; EACH COMPONENT IS ASSEMBLED IN SIXBIT FORM, AND WHEN IT IS TERMINATED
016 ;;; BY A BREAK CHARACTER, IT IS PUT INTO ONE OF FOUR SLOTS RESERVED ON FXP.
017 ;;; FOR CMU, WE ALSO ASSEMBLE THE CHARACTERS INTO PNBUF IN ASCII FORM,
018 ;;; SO THAT WE CAN USE THE CMUDEC UUO TO CONVERT A CMU-STYLE PPN.
019 ;;; AR1 HOLDS THE BYTE POINTER FOR ACCUMULATING A NAME.
020 ;;; AR2A HOLDS MANY FLAGS DESCRIBING THE STATE OF THE PARSE:
021 NMS==:1,,525252 ;FOR BIT-TYPEOUT MODE
022 NMS.CQ==:1 ;CONTROL-Q SEEN
023 NMS.CA==:2 ;CONTROL-A SEEN
024 IFN D10,[
025 NMS.DV==:10 ;DEVICE SEEN (AND TERMINATING :)
026 NMS.FN==:20 ;FILE NAME SEEN
027 NMS.DT==:40 ;. SEEN
028 NMS.XT==:100 ;EXTENSION SEEN
029 NMS.LB==:200 ;LEFT BRACKET SEEN
030 NMS.CM==:400 ;COMMA SEEN
031 NMS.RB==:1000 ;RIGHT BRACKET SEEN
032 NMS.ND==:10000 ;NON-OCTAL-DIGIT SEEN
033 NMS.ST==:20000 ;* SEEN
034 ] ;END OF IFN D10
035 ;;; CONTROL-A IS THE SAIL CONVENTION FOR QUOTING MANY CHARACTERS, BUT WE
036 ;;; ADOPT IT FOR ALL ITS AND D10 SYSTEMS.
037
038 008 013 NMS6B0: WTA [BAD NAMESTRING!]
039 NMS6BT: MOVEI TT,(A) ;DON'T ALLOW FIXNUMS AS NAMESTRINGS
040 LSH TT,-SEGLOG
041 MOVSI R,FX
042 TDNE R,ST(TT) ;A FIXNUM?
043 009 038 JRST NMS6B0 ;YES, ILLEGAL AS A NAMESTRING
044 PUSHN FXP,L.F6BT+1 ;FOUR WORDS FOR FINISHED NAMES, ONE FOR ACCUMULATION
045 MOVEI AR1,(FXP) ;AR1 HOLDS THE BYTE POINTER FOR ACCUMULATING A NAME
046 HRLI AR1,440600
047 SETZ AR2A, ;ALL FLAGS INITIALLY OFF
048 CMU$ PUSH FXP,PNBP ;FOR CMU, WE NEED THIS TO PARSE THE PPN
049 CMU$ SETZM PNBUF+LPNBUF-1
050 009 087 HRROI R,NMS6B1 .SEE PR.PRC
051 PUSH P,A
052 PUSHJ P,PRINTA ;PRINTA WILL CALL NMS6B1 WITH SUCCESSIVE CHARS IN A
053 009 022 TLNE AR2A,NMS.CA+NMS.CQ
CONVERSION: NAMESTRING => SIXBIT QIO[NEW,LSP] 09/18/78 Page 9.1
054 009 038 JRST NMS6B0 ;ILLEGAL FOR A QUOTE TO BE HANGING
055 MOVEI A,40
056 PUSHJ P,(R) ;FORCE A SPACE THROUGH TO TERMINATE LAST COMPONENT
057 POP P,A
058 IFN D10,[
059 009 029 TLNE AR2A,NMS.LB
060 009 031 TLNE AR2A,NMS.RB
061 CAIA
062 009 038 JRST NMS6B0 ;LOSE IF LEFT BRACKET SEEN BUT NO RIGHT BRACKET
063 ] ;END OF IFN D10
064 009 038 JUMPE AR1,NMS6B0 ;AR1 IS ZEROED IF THE PARSING CORUTINE DETECTS AN ERROR
065 POP FXP,1+CMU
066 MOVSI T,(SIXBIT \*\) ;CHANGE ANY ZERO COMPONENTS TO "*"
067 SKIPN -3(FXP)
068 MOVEM T,-3(FXP) ;DEVICE NAME
069 IT$ SKIPN -2(FXP)
070 IT$ MOVEM T,-2(FXP) ;SNAME
071 IFN D10,[
072 MOVE TT,-2(FXP) ;TREAT HALVES OF PPN SEPARATELY
073 TLNN TT,-1 ;A ZERO HALF BECOMES -1
074 TLO TT,-1
075 TRNN TT,-1
076 TRO TT,-1
077 MOVEM TT,-2(FXP)
078 ] ;END OF IFN D10
079 SKIPN -1(FXP)
080 MOVEM T,-1(FXP) ;FILE NAME 1
081 SKIPN (FXP)
082 MOVEM T,(FXP) ;FILE NAME 2/EXTENSION
083 POPJ P,
084
085 ;;; THIS IS THE NAMESTRING PARSING COROUTINE
086
087 NMS6B1: JUMPE AR1,CPOPJ ;ERROR HAS BEEN DETECTED, FORGET THIS CHARACTER
088 CAIN A,↑A
089 009 167 JRST NMS6BQ
090 CAIN A,↑Q
091 009 022 TLCE AR2A,NMS.CQ ;FOR A CONTROL-Q, SET THE CONTROL-Q BIT
092 CAIA ;IF IT WAS ALREADY SET, IT'S A QUOTED ↑Q
093 POPJ P, ;OTHERWISE EXIT
094 CAIN A,40 ;SPACE?
095 009 022 TLZN AR2A,NMS.CQ ;YES, QUOTED?
096 SKIPA ;NO TO EITHER TEST
097 009 149 JRST NMS6B9 ;YES TO BOTH, IS QUOTED SPACE
098 CAILE A,40 ;SKIP OF CONTROL CHARACTER OR SPACE
099 009 129 JRST NMS6B7
100 ;WE HAVE ENCOUNTERED A BREAK CHARACTER - DECIDE WHAT TO DO WITH COMPONENT
101 NMS6B8: SKIPN D,(AR1)
102 POPJ P, ;NO CHARACTERS ASSEMBLED YET
103 IT$ SKIPN -2(AR1) ;IF WE HAVE A FILE NAME 1, THIS MUST BE FN2
104 009 027 10$ TLNN AR2A,NMS.DT ;WE HAVE SEEN A DOT, THIS MUST BE THE EXTENSION
105 009 122 JRST NMS6B5 ;OTHERWISE THIS IS FILE NAME 1
106 IT$ SKIPE -1(AR1) ;LOSE IF WE ALREADY HAVE A FILE NAME 2
CONVERSION: NAMESTRING => SIXBIT QIO[NEW,LSP] 09/18/78 Page 9.2
107 009 031 10$ TLNE AR2A,NMS.XT+NMS.LB+NMS.CM+NMS.RB
108 009 168 JRST NMS6BL ;LOSE IF EXTENSION AFTER BRACKETS OR OTHER ONE
109 IT$ MOVEM D,-1(AR1)
110 10$ HLLZM D,-1(AR1)
111 009 028 10$ TLO AR2A,NMS.XT ;SET FLAG: WE'VE SEEN THE EXTENSION
112 ;COME HERE TO RESTORE THE BYTE POINTER FOR THE NEXT COMPONENT
113 NMS6B6: JUMPE AR1,CPOPJ ;IF AN ERROR HAS BEEN DETECTED, EXIT
114 HRLI AR1,440600
115 CMU$ MOVE D,PNBP ;FOR CMU, RESET THE PNBUF BYTE POINTER ALSO
116 CMU$ MOVEM D,1(AR1)
117 009 033 10$ TLZ AR2A,NMS.ND+NMS.ST ;RESET NON-OCTAL-DIGIT AND STAR SEEN FLAGS
118 SETZM (AR1) ;CLEAR ACCUMULATION WORD
119 POPJ P,
120
121 ;COME HERE FOR FILE NAME 1
122 NMS6B5:
123 009 031 10$ TLNE AR2A,NMS.FN+NMS.DT+NMS.XT+NMS.LB+NMS.CM+NMS.RB
124 009 168 10$ JRST NMS6BL ;LOSE IF TOO LATE FOR A FILE NAME
125 MOVEM D,-2(AR1) ;SAVE FILE NAME 1
126 009 113 JRST NMS6B6
127
128 ;HERE WITH A NON-CONTROL NON-SPACE CHARACTER
129 009 022 NMS6B7: TLZN AR2A,NMS.CQ
130 009 023 TLNE AR1,NMS.CA
131 009 149 JRST NMS6B9 ;IF CHARACTER QUOTED (FOR ↑Q, FLAG IS RESET)
132 CAIN A,":
133 009 171 JRST NMS6DV ;: SIGNALS A DEVICE NAME
134 IT$ CAIN A,";
135 009 181 IT$ JRST NMS6SN ;; MEANS AN SNAME
136 IFN D10,[
137 CAIN A,".
138 009 189 JRST NMS6PD ;PERIOD MEANS TERMINATION OF FILE NAME
139 CAIN A,133
140 009 195 JRST NMS6LB ;LEFT BRACKET
141 CAIN A,",
142 009 202 JRST NMS6CM ;COMMA
143 CAIN A,135
144 009 214 JRST NMS6RB ;RIGHT BRACKET
145 CAIN A,"*
146 009 237 JRST NMS6ST ;STAR
147 ] ;END OF IFN D10
148 ;HERE TO DUMP A CHARACTER INTO THE ACCUMULATING COMPONENT
149 NMS6B9:
150 IFN CMU,[
151 SKIPE PNBUF+LPNBUF-1
152 TDZA AR1,AR1 ;ASSUME A COMPONENT THAT FILLS PNBUF IS A LOSER
153 IDPB A,1(AR1) ;STICK ASCII CHARACTER IN PNBUF
154 ] ;END OF IFN CMU
155 IFN D10,[
156 CAIL A,"0
157 CAILE A,"7
158 009 032 TLO AR2A,NMS.ND ;SET FLAG IF NON-OCTAL-DIGIT
159 NMS6B4:
CONVERSION: NAMESTRING => SIXBIT QIO[NEW,LSP] 09/18/78 Page 9.3
160 ] ;END OF IFN D10
161 CAIGE A,140 ;CONVERT LOWER CASE TO UPPER,
162 SUBI A,40 ; AND ASCII TO SIXBIT
163 TLNE AR1,770000
164 IDPB A,AR1 ;DUMP CHARACTER INTO ACCUMULATING NAME
165 POPJ P,
166
167 009 023 NMS6BQ: TLCA AR2A,NMS.CA ;COMPLEMENT CONTROL-A FLAG
168 NMS6BL: SETZ AR1, ;ZEROING AR1 INDICATES A PARSE ERROR
169 POPJ P,
170
171 NMS6DV: SKIPE D,(AR1) ;ERROR IF : SEEN WITH NO PRECEDING COMPONENT
172 10$ ;ERROR AFTER OTHER CRUD
173 009 031 10$ TLNE AR2A,NMS.DV+NMS.FN+NMS.DT+NMS.XT+NMS.LB+NMS.CM+NMS.RB
174 10% SKIPE -4(AR1) ;ERROR IF DEVICE NAME ALREADY SEEN
175 009 168 JRST NMS6BL
176 MOVEM D,-4(AR1)
177 009 025 10$ TLO AR2A,NMS.DV
178 009 113 JRST NMS6B6 ;RESET BYTE POINTER
179
180 IFN ITS,[
181 NMS6SN: SKIPE D,(AR1) ;ERROR IF ; SEEN WITHOUT PRECEDING COMPONENT
182 SKIPE -3(AR1) ;ERROR IF WE ALREADY HAVE AN SNAME
183 009 168 JRST NMS6BL
184 MOVEM D,-3(AR1)
185 009 113 JRST NMS6B6 ;RESET BYTE POINTER
186 ] ;END OF IFN ITS
187
188 IFN D10,[
189 009 031 NMS6PD: TLNE AR2A,NMS.DT+NMS.XT+NMS.LB+NMS.CM+NMS.RB
190 009 168 JRST NMS6BL
191 009 101 PUSHJ P,NMS6B8 ;DOT SEEN - SEE IF IT TERMINATED THE FILE NAME
192 009 027 TLO AR2A,NMS.DT ;SET PERIOD (DOT) FLAG
193 POPJ P,
194
195 009 031 NMS6LB: TLNE AR2A,NMS.LB+NMS.CM+NMS.RB
196 009 168 JRST NMS6BL ;LEFT BRACKET ERROR IF ALREADY A BRACKET
197 009 101 PUSHJ P,NMS6B8 ;DID WE TERMINATE THE FILE NAME OR EXTENSION?
198 009 029 TLO AR2A,NMS.LB ;SET LEFT BRACKET FLAG
199 NMS6L1: HRLI AR1,440300
200 POPJ P,
201
202 NMS6CM: LDB D,[360600,,AR1]
203 CAIE D,44 ;ERROR IF NO CHARACTERS AFTER LEFT BRACKET
204 009 029 TLNN AR2A,NMS.LB ;ERROR IF NO LEFT BRACKET!
205 009 168 JRST NMS6BL
206 009 031 TLNE AR2A,NMS.ND+NMS.CM+NMS.RB
207 009 168 JRST NMS6BL ;ERROR IF NON-OCTAL-DIG, COMMA, OR RGT BRACKET
208 009 241 PUSHJ P,NMS6PP ;HACK HALF A PPN
209 HRLM D,-3(AR1)
210 009 030 TLO AR2A,NMS.CM ;SET COMMA FLAG
211 SETZM (AR1) ;CLEAR COLLECTING WORD
212 009 199 JRST NMS6L1 ;RESET BYTE POINTER
CONVERSION: NAMESTRING => SIXBIT QIO[NEW,LSP] 09/18/78 Page 9.4
213
214 NMS6RB:
215 LDB D,[360600,,AR1]
216 009 030 CMU% TLNE AR2A,NMS.CM ;MUST HAVE COMMA BEFORE RIGHT BRACKET
217 CAIN D,44 ;ERROR IF NO CHARS SINCE COMMA/LEFT BRACKET
218 009 168 JRST NMS6BL
219 009 029 TLNE AR2A,NMS.LB ;ERROR IF NO LEFT BRACKET
220 009 031 TLNE AR2A,NMS.RB ;ERROR IF RIGHT BRACKET ALREADY SEEN
221 009 168 JRST NMS6BL
222 009 030 CMU$ TLNE AR2A,NMS.CM ;FOR CMU, NO COMMA MEANS A CMU-STYLE PPN
223 009 230 CMU$ JRST NMS6R1
224 009 241 PUSHJ P,NMS6PP ;FIGURE OUT HALF A PPN
225 HRRM D,-3(AR1)
226 009 031 NMS6R2: TLO AR2A,NMS.RB ;SET RIGHT BRACKET FLAG
227 009 113 JRST NMS6B6 ;RESET THE WORLD
228
229 IFN CMU,[
230 NMS6R1: MOVEI D,PNBUF
231 CMUDEC D, ;CONVERT CMU-STYLE PPN TO A WORD
232 009 168 JRST NMS6BL ;LOSE LOSE
233 MOVEM D,-3(AR1) ;WIN - SAVE IT AWAY
234 009 226 JRST NMS6R2
235 ] ;END OF IFN CMU
236
237 009 033 NMS6ST: TLOE AR2A,NMS.ST ;SET STAR FLAG, SKIP IF NOT ALREADY SET
238 009 032 TLO AR2A,NMS.ND ;TWO STARS = A NON-DIGIT FOR PPN PURPOSES
239 009 159 JRST NMS6B4
240
241 009 032 NMS6PP: TLNE AR2A,NMS.ND
242 SETZ AR1, ;NON-DIGIT IN PPN IS AN ERROR
243 HRRZI D,-1
244 009 033 TLNE AR2A,NMS.ST ;STAR => 777777
245 POPJ P,
246 LDB TT,[360600,,AR1]
247 CAIGE TT,22
248 SETZ AR1, ;MORE THAN SIX DIGITS LOSES
249 MOVNS TT
250 MOVE D,(AR1)
251 LSH D,(TT) ;RIGHT-JUSTIFY THE DIGITS
252 POPJ P,
253 ] ;END OF IFN D10
254
255 ] ;END OF IFN ITS+D10
CONVERSION: NAMESTRING => SIXBIT QIO[NEW,LSP] 09/18/78 Page 10
001 IFN D20,[
002
003 ;;; THE STRATEGY HERE IS TO USE GTJFN TO PARSE THE STRING,
004 ;;; THEN GET THE VARIOUS COMPONENTS BACK SINGLY WITH JFNS.
005
006 NMS6B0: MOVE FXP,D ;D HAS SAVED FXP
007 PUSH FXP,F ;F HAS SAVED LOCKI WORD
008 UNLOCKI
009 %WTA (C)
010 008 013 NMS6BT: MOVEI C,[SIXBIT \FIXNUM ILLEGAL AS NAMESTRING\]
011 MOVEI TT,(A) ;DON'T ALLOW FIXNUMS AS NAMESTRINGS
012 LSH TT,-SEGLOG
013 MOVSI R,FX
014 TDNE R,FX ;A FIXNUM?
015 009 038 JRST NMS6B0 ;YES, ILLEGAL AS A NAMESTRING
016 LOCKI ;LOCK OUT INTERRUPTS (BECAUSE OF JSYS'S)
017 POP FXP,F ;POP LOCKI WORD
018 MOVE D,FXP ;SAVE LEVEL OF FXP
019 PUSHJ P,PNBFMK ;STRING OUT CHARACTERS INTO PNBUF
020 008 013 MOVEI C,[SIXBIT \NAMESTRING TOO LONG!\]
021 009 038 JUMPE AR2A,NMS6B0 ;LOSE IF DIDN'T FIT IN PNBUF
022 IDPB NIL,AR1 ;TERMINATE STRING WITH A NULL
023 MOVSI 1,(GJ%ACC+GJ%OFG+GJ%FLG+GJ%SHT)
024 MOVE 2,PNBP
025 WARN [I SUSPECT THAT TO DO OMITTED NAMES RIGHT WE MAY NEED A LONG GTJFN]
026 GTJFN ;GET A JFN FOR PARSED NAMESTRING
027 009 038 IOJRST 0,NMS6B0
028 PUSH FXP,F ;PUSH BACK LOCKI WORD
029 TDZA R,R ;R=0 => NMS6BT
030 JFN6BT: MOVEI R,1 ;CONVERT JFN IN 1 TO "SIXBIT" ON FXP
031 POP FXP,F ;POP LOCKI WORD (COME IN LOCKED, EXIT UNLOCKED)
032 012 110 MOVE D,FXP .SEE TRUENAME ;SAVES T, SKIP RETURN ON FAILURE
033 MOVE 2,1
034 MOVSI 3,.JSAOF←17 .SEE JS%DEV JS%DIR JS%NAM JS%TYP JS%GEN
035 IRP LEN,,[L.6DEV,L.6DIR,L.6FNM,L.6EXT,L.6VRS]10XFLD,,[DEVICE,DIRECTORY,NAME,EXTENSION
036 VERSION]20XFLD,,[DEVICE,DIRECTORY,NAME,TYPE,GENERATION]FLAG,,[1,0,0,0,0]
037 SETZM PNBUF
038 MOVE T,[PNBUF,,PNBUF+1]
039 BLT T,PNBUF+LEN-1 ;CLEAR OUT PNBUF
040 MOVE 1,PNBP
041 PUSH P,3 ;SAVE FLAGS OVER CALL
042 JFNS ;GET ASCII STRING FOR NEXT COMPONENT IN PNBUF
043 010 060 IFN FLAG, ERJMP JFN6ER ;IF ERROR THEN TRY DEVST
044 10X MOVEI C,[SIXBIT \10XFLD FIELD TOO LONG!\]
045 20X MOVEI C,[SIXBIT \20XFLD FIELD TOO LONG!\]
046 LDB T,[010700,,PNBUF+LEN-1]
047 009 129 JUMPN T,NMS6B7
048 POP P,3
049 DPB NIL,[010700,,PNBUF+LEN-1]
050 REPEAT LEN, PUSH FXP,PNBUF+.RPCNT
051 LSH 3,-3 .SEE JS%DEV JS%DIR JS%NAM JS%TYP JS%GEN
052 TERMIN
053 010 057 NMS6BZ: JUMPN R,NMS6B2
CONVERSION: NAMESTRING => SIXBIT QIO[NEW,LSP] 09/18/78 Page 10.1
054 MOVEI 1,(2)
055 RLJFN ;RELEASE THE JFN FOR NMS6BT
056 HALT
057 NMS6B2: PUSH FXP,F ;PUSH LOCKI WORD BACK
058 UNLKPOPJ
059
060 JFN6ER: CAIE 2,.PRIIN ;PRIMARY INPUT?
061 CAIN 2,.PRIOU ;OR PRIMARY OUTPUT
062 SKIPA ;YES
063 009 129 JRST NMS6B7 ;NOPE, FAIL
064 PUSH FXP,[ASCII/PRIMA/]
065 PUSH FXP,[ASCIZ/RY/]
066 REPEAT <L.6DEV-2>+L.6DIR+L.6FNM+L.6EXT+L.6VRS, PUSH FXP,R70
067 POPI P,1
068 010 053 JRST NMS6BZ
069
070 NMS6B7: POPI P,1
071 009 038 JUMPE R,NMS6B0 ;FOR NMS6BT, GO GIVE WTA ERROR
072 AOS (P) ;FOR JFN6BT, SKIP ON FAILURE
073 MOVE FXP,D ; WITH NO CRUD ON FXP AT ALL
074 010 057 JRST NMS6B2
075 ] ;END OF IFN D20
CONVERSION: ANY FILE SPEC => SIXBIT QIO[NEW,LSP] 09/18/78 Page 11
001 SUBTTL CONVERSION: ANY FILE SPEC => SIXBIT
002
003 ;;; TAKE ARGUMENT IN A (MAY BE FILE ARRAY, NAMELIST,
004 ;;; OR NAMESTRING), FIGURE IT OUT AND SOMEHOW RETURN
005 ;;; "SIXBIT" FORMAT ON FXP.
006 ;;; IFL6BT SAYS THAT T MEANS TTY INPUT, NOT TTY OUTPUT.
007
008 ;;; SAVES C AR1 AR2A
009
010 IFL6BT: CAIN A,TRUTH
011 HRRZ A,V%TYI
012 011 020 JRST FIL6B0
013 IFN SFA,[
014 FILSFA: MOVEI B,QNAME ;EXTRACT THE "FILENAME" FROM THE SFA
015 SETZ C, ;NO ARGS
016 047 133 PUSHJ P,ISTCSH ;SHORT CALL, THEN USE RESULT AS NEW NAME
017 ] ;END IFN SFA
018 FIL6BT: CAIN A,TRUTH
019 HRRZ A,V%TYO
020 FIL6B0: SKIPN A ;NIL => DEFAULTS
021 HRRZ A,VDEFAULTF
022 FIL6B1: MOVEI R,(A)
023 LSH R,-SEGLOG
024 SKIPGE R,ST(R)
025 006 088 JRST NML6BT ;LIST => NAMELIST
026 TLNN R,SA
027 011 043 JRST FIL6B2 ;NOT ARRAY => NAMESTRING
028 MOVE R,ASAR(A)
029 SFA$ TLNE R,AS.SFA ;AN SFA?
030 011 014 SFA$ JRST FILSFA ;YES, EXTRACT NAME FROM IT AND TRY AGAIN
031 TLNN R,AS<JOB+FIL>
032 009 038 JRST NMS6B0 ;INCOMPREHENSIBLE NAMESTRING
033 LOCKI ;FOR FILE, GOBBLE NAMES OUT OF FILE OBJECT
034 POP FXP,D ;POP LOCKI WORD
035 MOVE TT,TTSAR(A)
036 ADDI TT,F.DEV
037 HRLI TT,-L.F6BT
038 PUSH FXP,(TT) ;PUSH ALL WORDS OF FILE SPEC
039 AOBJN TT,.-1
040 PUSH FXP,D ;PUSH BACK LOCKI WORD
041 UNLKPOPJ ;UNLOCK AND EXIT
042
043 011 046 FIL6B2: JSP T,QIOSAV
044 009 039 JRST NMS6BT
045
046 QIOSAV: SAVE B C AR1 AR2A
047 PUSHJ P,(T)
048 RSTR AR2A AR1 C B
049 POPJ P,
050 .SEE 6BTNS8 ;RELIES ON AC C BEING SAVED IN CERTAIN SPOT
MERGING ROUTINES, MERGEF, TRUENAME, PROBEF QIO[NEW,LSP] 09/18/78 Page 12
001 SUBTTL MERGING ROUTINES, MERGEF, TRUENAME, PROBEF
002
003 ;;; MERGEF TAKES TWO FILE SPECS OF ANY KIND, MERGES THEM,
004 ;;; AND RETURNS A NAMELIST OF THE RESULTING SPECS.
005 ;;; AS A CROCK, (MERGEF X '*) SIMPLY MAKES THE SECOND
006 ;;; FILE NAME (FOR D20, THE VERSION) BE *.
007
008 MERGEF: PUSH P,B
009 011 018 PUSHJ P,FIL6BT
010 POP P,A
011 CAIE A,Q.
012 012 018 JRST MRGF1
013 20% MOVSI T,(SIXBIT \*\)
014 20% MOVEM T,(FXP)
015 20$ REPEAT L.6VRS, SETZM -.RPCNT(FXP)
016 JRST 6BTNML
017
018 011 018 MRGF1: PUSHJ P,FIL6BT
019 012 066 PUSHJ P,IMRGF
020 JRST 6BTNML
021
022 ;;; IMRGF MERGES TWO SETS OF SPECS ON THE FIXNUM PDL.
023 ;;; DMRGF MERGES A SET WITH THE DEFAULT FILE NAMES.
024 ;;; DEC-10 PPN'S MERGE HALVES OF THE PPN SEPARATELY;
025 ;;; AN UNSPECIFIED HALF IS -1 OR 0, *NOT* (SIXBIT \*\)!!
026 ;;; SAVES F (SEE LOAD).
027
028 DMRGF:
029 ;FIRST SEE WHETHER WE REALLY NEED TO CONVERT THE DEFAULTS TO "SIXBIT"
030 IFN ITS+D10,[
031 MOVSI TT,(SIXBIT \*\)
032 REPEAT L.F6BT,[
033 IFN ITS\<.RPCNT-1>,[
034 CAME TT,.RPCNT-3(FXP) ;MUST MERGE IF FILE NAME IS ZERO OR *
035 SKIPN .RPCNT-3(FXP)
036 012 062 JRST DMRGF5
037 ] ;END OF IFN ITS\<.RPCNT-1>
038 .ELSE,[
039 MOVE T,.RPCNT-3(FXP)
040 TLCE T,-1
041 TLNN T,-1
042 012 062 JRST DMRGF5
043 TRCE T,-1
044 TRNN T,-1
045 012 062 JRST DMRGF5
046 ] ;END OF .ELSE
047 ] ;END OF REPEAT L.F6BT
048 ] ;END OF IFN ITS+D10
049 IFN D20,[
050 MOVSI TT,(ASCII \*\)
051 ZZZ==0
052 IRP FOO,,[L.6VRS,L.6EXT,L.6FNM,L.6DIR,L.6DEV]
053 012 051 ZZZ==ZZZ+FOO
MERGING ROUTINES, MERGEF, TRUENAME, PROBEF QIO[NEW,LSP] 09/18/78 Page 12.1
054 012 051 CAME TT,-ZZZ+1(FXP)
055 012 051 SKIPN -ZZZ+1(FXP)
056 012 062 JRST DMRGF5
057 TERMIN
058 012 051 EXPUNGE ZZZ
059 ] ;END OF IFN D20
060 POPJ P, ;MERGE WOULDN'T DO ANYTHING - FORGET IT
061
062 DMRGF5: PUSH FLP,F ;MERGE WITH DEFAULT FILE NAMES
063 HRRZ A,VDEFAULTF
064 011 018 PUSHJ P,FIL6BT
065 POP FLP,F
066 IMRGF:
067 IFN ITS+D10,[
068 MOVEI T,L.F6BT ;MERGE TWO SETS OF NAMES ON FXP
069 MOVSI TT,(SIXBIT \*\)
070 MRGF2:
071 10$ MOVE R,D
072 POP FXP,D
073 10$ CAIE T,2 ;PPN IS PENULTIMATE FROB - DON'T COMPARE TO *
074 CAME TT,-3(FXP)
075 SKIPN -3(FXP)
076 MOVEM D,-3(FXP)
077 012 070 SOJG T,MRGF2
078 10$ MOVE D,-2(FXP) ;R HAS PPN 2 - GET PPN 1 IN D
079 10$ TLCE D,-1 ;IF 0
080 10$ TLNN D,-1 ;OR -1
081 10$ HLLM R,-2(FXP) ;DEFAULT
082 10$ TRCE D,-1
083 10$ TRNN D,-1
084 10$ HRRM R,-2(FXP)
085 ] ;END OF IFN ITS+D10
086 IFN D20,[
087 MOVSI TT,(ASCII \*\)
088 IRP FOO,,[VRS,EXT,FNM,DIR,DEV]
089 CAME TT,-L.6!FOO-L.F6BT+1(FXP)
090 SKIPN -L.6!FOO-L.F6BT+1(FXP)
091 JRST IM!FOO!1
092 POPI FXP,L.6!FOO
093 JRST IM!FOO!2
094 IM!FOO!1:
095 IFLE L.6!FOO-3, REPEAT L.6!FOO, POP FXP,-L.F6BT(FXP)
096 .ELSE,[
097 MOVEI T,L.6!FOO
098 POP FXP,-L.F6BT(FXP)
099 SOJG T,.-1
100 ] ;END OF .ELSE
101 IM!FOO!2:
102 TERMIN
103 ] ;END OF IFN D20
104 C6BTNML: POPJ P,6BTNML
105
106 ;;; (TRUENAME <FILE>) RETURNS THE RESULT OF .RCHST ON ITS,
MERGING ROUTINES, MERGEF, TRUENAME, PROBEF QIO[NEW,LSP] 09/18/78 Page 12.2
107 ;;; I.E. THE REAL FILE NAMES AFTER TRANSLATIONS, LINKS, ETC.
108 ;;; THE RESULT IS A NAMELIST.
109
110 TRUENAME:
111 IFN SFA,[
112 EXCH AR1,A
113 004 007 JSP TT,XFOSP ;FILE OR SFA OR NOT?
114 012 146 JRST TRUNM9 ;NOT
115 012 121 JRST TRUNMZ ;FILE
116 EXCH A,AR1
117 011 046 JSP T,QIOSAV
118 MOVEI B,QTRUENAME
119 SETZ C, ;NO THIRD ARG
120 047 133 JRST ISTCSH ;SHORTY INTERNAL STREAM CALL
121 TRUNMZ: EXCH A,AR1
122 ] ;END IFN SFA
123 012 104 PUSH P,C6BTNML ;SUBR 1
124 TRU6BT: CAIN A,TRUTH
125 HRRZ A,V%TYO
126 TRUNM2: EXCH AR1,A
127 LOCKI
128 004 008 JSP TT,XFILEP
129 012 145 JRST TRUNM8
130 MOVE TT,TTSAR(AR1) ;REST OF ROUTINE NEEDS TTSAR IN TT
131 EXCH AR1,A
132 IFN ITS+D10,[
133 POP FXP,T ;POP LOCKI WORD
134 REPEAT L.F6BT, PUSH FXP,F.RDEV+.RPCNT(TT)
135 PUSH FXP,T
136 UNLKPOPJ
137 ] ;END OF ITS+D10
138 IFN D20,[
139 PUSH P,A ;GC PROTECT THE ARGUMENT
140 MOVE 1,F.JFN(TT)
141 010 030 PUSHJ P,JFN6BT ;GET "SIXBIT" ON FXP, AND UNLOCKI
142 JRST POPAJ
143 ] ;END OF IFN D20
144
145 TRUNM8: UNLOCKI
146 TRUNM9: EXCH AR1,A
147 005 048 %WTA NFILE ;NOT FILE
148 012 104 SFA$ MOVE T,C6BTNML ;IF NOT CALLED AS A SUBR, ONLY ACCEPT A FILE
149 SFA$ CAME T,(P)
150 012 126 JRST TRUNM2
151 SFA$ POPI P,1
152 012 110 SFA$ JRST TRUENAME
153
154 ;;; (STATUS UREAD)
155
156 SUREAD: SKIPN A,VUREAD
157 POPJ P,
158 012 110 PUSHJ P,TRUENAME
159 HLRZ B,(A)
MERGING ROUTINES, MERGEF, TRUENAME, PROBEF QIO[NEW,LSP] 09/18/78 Page 12.3
160 HRRZ A,(A)
161 HRRZ C,(A)
162 20$ HRRZ C,(C)
163 20$ HRRM C,(A)
164 HRRM B,(C)
165 POPJ P,
166
167 ;;; (STATUS UWRITE)
168
169 SUWRITE: SKIPE A,VUWRITE
170 012 110 PUSHJ P,TRUENAME
171 JRST $CAR ;(CAR NIL) => NIL
MERGING ROUTINES, MERGEF, TRUENAME, PROBEF QIO[NEW,LSP] 09/18/78 Page 13
001 ;;; ROUTINE TO SET UP ARGS FOR TWO-ARGUMENT FILE FUNCTION.
002 ;;; PUT TWO SETS OF FILE NAMES ON FXP. IF THE ARGS ARE
003 ;;; X AND Y, THEN THE NAMES ON FXP ARE (MERGEF X NIL) AND
004 ;;; (MERGEF Y (MERGEF X NIL)). THE FIRST ARG IS LEFT IN AR1.
005
006 2MERGE: PUSH P,A
007 PUSH P,B
008 011 018 PUSHJ P,FIL6BT
009 012 028 PUSHJ P,DMRGF
010 POP P,A
011 011 018 PUSHJ P,FIL6BT
012 MOVEI T,L.F6BT
013 PUSH FXP,-2*L.F6BT+1(FXP)
014 SOJG T,.-1
015 012 066 PUSHJ P,IMRGF ;NOW WE HAVE THE MERGED FILE SPECS
016 POP P,AR1 ;FIRST ARG
017 POPJ P,
018
019
020 ;;; (PROBEF X) TRIES TO DECIDE WHETHER FILE X EXISTS.
021 ;;; ON ITS AND D10 THIS IS DONE BY TRYING TO OPEN THE FILE.
022 ;;; ON D20 WE USE THE GTJFN JSYS.
023 ;;; RETURNS REAL FILE NAMES ON SUCCESS, NIL ON FAILURE.
024
025 PROBEF: ;SUBR 1
026 IFN SFA,[
027 004 005 JSP TT,AFOSP ;DO WE HAVE AN SFA?
028 013 033 JRST PROBEZ ;NOPE
029 013 033 JRST PROBEZ ;NOPE
030 MOVEI B,QPROBEF ;PROBEF OPERATION
031 SETZ C, ;NO ARGS
032 047 133 JRST ISTCSH ;SHORT CALL, RETURN RESULTS
033 PROBEZ: ] ;END IFN SFA
034 011 018 PUSHJ P,FIL6BT
035 012 028 PROBF0: PUSHJ P,DMRGF
036 IFN ITS,[
037 LOCKI
038 SETZ TT, ;ASSUME NO CONTROL ARG
039 MOVSI T,'USR ;CHECK FOR USR DEVICE
040 CAMN T,-3-1(FXP) ;MATCH?
041 TRO TT,10 ;SET BIT 1.4 (INSIST ON EXISTING JOB)
042 013 116 .CALL PROBF8
043 013 110 JRST PROBF6
044 013 125 .CALL PROBF9
045 .LOSE 1400
046 .CLOSE TMPC,
047 UNLOCKI
048 ] ;END OF IFN ITS
049 IFN D10,[
050 LOCKI
051 MOVEI T,.IODMP ;I/O MODE (DUMP MODE)
052 MOVE TT,-3-1(FXP) ;DEVICE NAME
053 SETZ D,
MERGING ROUTINES, MERGEF, TRUENAME, PROBEF QIO[NEW,LSP] 09/18/78 Page 13.1
054 OPEN TMPC,T
055 013 110 JRST PROBF6 ;NO SUCH FILE IF NO SUCH DEVICE!
056 IFE SAIL,[
057 MOVEI T,3 ;ONLY NEED 3 ARGS OF EXTENDED LOOKUP
058 MOVE D,-1-1(FXP) ;FILE NAME
059 HLLZ R,0-1(FXP) ;EXTENSION
060 MOVE TT,-2-1(FXP) ;PPN
061 ] ;END IFE SAIL
062 IFN SAIL,[
063 MOVE T,-1-1(FXP) ;FILE NAME
064 HLLZ TT,0-1(FXP) ;EXTENSION
065 SETZ D, ;UNUSED
066 MOVE R,-2-1(FXP) ;PPN
067 ] ;END IFN SAIL
068 LOOKUP TMPC,T
069 013 109 JRST PROBF5 ;FILE DOESN'T EXIST
070 013 075 PUSHJ P,D10RFN ;READ BACK FILE NAMES
071 RELEASE TMPC, ;RELEASE TEMP CHANNEL
072 UNLOCKI
073 JRST 6BTNML ;FORM NAMELIST ON SUCCESS
074
075 D10RFN: MOVEI F,TMPC ;WE WILL GET DEVICE NAME FROM MONITOR
076 SA% DEVNAM F,
077 SA$ PNAME F,
078 SKIPA ;NONE SO RETAIN OLD NAME
079 MOVEM F,-3-1(FXP) ;ELSE STORE NEW DEVICE NAME
080 IFE SAIL,[
081 MOVEM TT,-2-1(FXP) ;STORE DATA AS RETURNED FROM EXTENDED LOOKUP
082 MOVEM D,-1-1(FXP)
083 HLLZM R,0-1(FXP)
084 ] ;END IFE SAIL
085 IFN SAIL,[
086 MOVEM T,-1-1(FXP) ;SAIL HAS NO EXTENDED LOOKUP!!!!!
087 HLLZM TT,0-1(FXP) ; SO, WE CAN'T STORE PPN; JUST ASSUME IT IS
088 ; WHAT WE GAVE IT
089 ] ;END IFN SAIL
090 POPJ P,
091 ] ;END OF IFN D10
092 IFN D20,[
093 PUSHJ P,6BTNS ;GET NAMESTRING IN PNBUF
094 LOCKI
095 MOVSI 1,(GJ%OLD+GJ%ACC+GJ%SHT) .SEE .GJDEF
096 MOVE 2,PNBP
097 GTJFN ;GET A JFN (INSIST ON EXISTING FILE)
098 JRST UNLKFALSE
099 PUSH FLP,1 ;SAVEE JFN OVER JFN6BT
100 010 030 PUSHJ P,JFN6BT ;CONVERT JFN TO "SIXBIT" FORMAT ON FXP
101 POP FLP,1
102 RLJFN ;RELEASE THE JFN
103 HALT
104 ] ;END OF IFN D20
105
106 10% JRST 6BTNML
MERGING ROUTINES, MERGEF, TRUENAME, PROBEF QIO[NEW,LSP] 09/18/78 Page 13.2
107
108 IFN ITS+D10,[
109 10$ PROBF5: RELEASE TMPC,
110 PROBF6: UNLOCKI
111 POPI FXP,L.F6BT ;POP "SIXBIT" CRUD FROM FXP
112 JRST FALSE ;RETURN FALSE ON FAILURE
113 ] ;END OF IFN ITS+D10
114
115 IFN ITS,[
116 PROBF8: SETZ
117 SIXBIT \OPEN\ ;OPEN FILE (ASCII UNIT INPUT)
118 4000,,TT ;CONTROL ARG (DON'T CREATE BIT SET FOR USR)
119 1000,,TMPC ;CHANNEL #
120 ,,-3-1(FXP) ;DEVICE NAME
121 ,,-1-1(FXP) ;FILE NAME 1
122 ,,0-1(FXP) ;FILE NAME 2
123 400000,,-2-1(FXP) ;SNAME
124
125 PROBF9: SETZ
126 014 172 SIXBIT \RFNAME\ ;READ REAL FILE NAMES
127 1000,,TMPC ;CHANNEL #
128 2000,,-3-1(FXP) ;DEVICE NAME
129 2000,,-1-1(FXP) ;FILE NAME 1
130 2000,,0-1(FXP) ;FILE NAME 2
131 402000,,-2-1(FXP) ;SNAME
132 ] ;END OF IFN ITS
RENAMEF FUNCTION, CNAMEF FUNCTION QIO[NEW,LSP] 09/18/78 Page 14
001 SUBTTL RENAMEF FUNCTION, CNAMEF FUNCTION
002
003 ;;; (RENAMEF X Y) RENAMES (MERGEF X (NAMELIST NIL)) TO BE
004 ;;; (MERGEF Y (MERGEF X (NAMELIST NIL))).
005 ;;; IF X IS AN OUTPUT FILE ARRAY, IT IS RENAMED AND CLOSED.
006
007 $RENAMEF:
008 PUSHJ P,2MERGE ;2MERGE LEAVES ARG 1 IN AR1
009 004 008 JSP TT,XFILEP ;SKIP IF FILE ARRAY
010 014 087 JRST RENAM2
011 MOVE TT,TTSAR(AR1)
012 TLNE TT,TTS.CL
013 014 087 JRST RENAM2
014 HLLOS NOQUIT
015 MOVEI A,(AR1)
016 IFN ITS,[
017 014 131 .CALL RENAM7 ;MUST RENAME WHILE OPEN
018 014 158 IOJRST 0,RENAM6
019 ] ;END OF IFN ITS
020 016 050 PUSHJ P,JCLOSE ;RETURNS CHANNEL IN T, TTSAR IN TT
021 IFN D10,[
022 MOVE F,F.CHAN(TT)
023 MOVE T,-1(FXP)
024 HLLZ TT,(FXP)
025 SETZ D,
026 MOVE R,-2(FXP)
027 LSH F,27
028 IOR F,[RENAME 0,T]
029 XCT F
030 014 158 IOJRST 0,RENAM6
031 SA$ XOR F,[<CLOSE 0,0>#<RENAME 0,T>]
032 SA$ XCT F
033 SA$ XOR F,[<RELEASE 0,0>#<CLOSE 0,0>]
034 SA% XOR F,[<RELEASE 0,0>#<RENAME 0,T>]
035 XCT F
036 ] ;END OF IFN D10
037 IFN D20,[
038 PUSH P,F.JFN(TT)
039 RENAM0: PUSH P,[-1]
040 008 021 PUSHJ P,X6BTNS
041 POPI P,1
042 POP P,T
043 MOVSI 1,(GJ%FOU+GJ%NEW+GJ%ACC+GJ%SHT)
044 MOVE 2,PNBP
045 GTJFN
046 014 150 IOJRST 0,RENAM5
047 MOVE 2,1
048 MOVE 1,T
049 HRLI 1,(CO%NRJ)
050 CLOSF
051 014 148 IOJRST 0,RENAM4
052 TLZ 1,-1
053 RNAMF
RENAMEF FUNCTION, CNAMEF FUNCTION QIO[NEW,LSP] 09/18/78 Page 14.1
054 014 148 IOJRST 0,RENAM4
055 MOVE 1,2
056 RLJFN ;? SHOULD GC DO THE RELEASE?
057 HALT
058 ] ;END OF IFN D20
059 IFN ITS+D10,[
060 MOVE F,-1(FXP) ;UPDATE THE FILE NAMES
061 MOVEM F,F.FN1(TT)
062 10$ MOVEM F,F.RFN1(TT)
063 IT$ MOVE F,(FXP)
064 10$ HLLZ F,(FXP)
065 MOVEM F,F.FN2(TT)
066 10$ MOVEM F,F.RFN2(TT)
067 10$ MOVE F,-2(FXP)
068 10$ MOVEM F,F.PPN(TT)
069 10$ MOVEM F,F.RPPN(TT)
070 014 172 IT$ .CALL RFNAME ;READ BACK THE TRUENAMES
071 IT$ .LOSE 1400 ;END OF IFN ITS+D10
072 016 044 IT$ .CALL CLOSE9
073 IT$ .LOSE 1400
074 ] ;END OF IFN ITS+D10
075 IFN D20,[
076 MOVEI T,F.DEV(TT)
077 HRLI T,-L.F6BT+1(FXP)
078 BLT T,F.DEV+L.F6BT-1(TT)
079 ] ;END OF IFN D20
080 PUSHJ P,CZECHI
081 POPI FXP,L.F6BT
082 014 125 20$ JUMPE AR1,RENAM3
083 MOVEI A,(AR1)
084 RENAM1: POPI FXP,L.F6BT
085 POPJ P,
086
087 RENAM2:
088 IFN ITS,[
089 014 137 .CALL RENAM8 ;ORDINARY RENAME
090 014 159 IOJRST 0,RENAM9
091 ] ;END OF IFN ITS
092 IFN D10,[
093 MOVEI T,.IODMP ;TO RENAME A FILE, WE OPEN A DUMP MODE CHANNEL
094 MOVE TT,-7(FXP) ;GET DEVICE NAME
095 SETZ D,
096 OPEN TMPC,T ;OPEN CHANNEL
097 014 148 JRST RENAM4
098 MOVE T,-5(FXP) ;FILE NAME
099 HLLZ TT,-4(FXP) ;EXTENSION
100 SETZ D,
101 MOVE R,-6(FXP) ;PPN
102 LOOKUP TMPC,T ;LOOK UP FILE
103 014 150 IOJRST 0,RENAM5
104 MOVE T,-1(FXP) ;NEW FILE NAME
105 HLLZ TT,(FXP) ;NEW EXTENSION
106 SETZ D,
RENAMEF FUNCTION, CNAMEF FUNCTION QIO[NEW,LSP] 09/18/78 Page 14.2
107 MOVE R,-2(FXP) ;NEW PPN
108 RENAME TMPC,T ;RENAME FILE
109 014 150 IOJRST 0,RENAM5
110 RELEASE TMPC,
111 ] ;END OF IFN D10
112 IFN D20,[
113 MOVEI T,L.F6BT
114 PUSH FXP,-2*L.F6BT+1(FXP) ;COPY OLD FILE NAMES TO TOP OF FXP
115 SOJG T,.-1
116 PUSH P,[-1] ;FLAG SAYING LONG NAMESTRING
117 PUSHJ P,6BTNS ;STRING OUT INTO PNBUF
118 POPI P,1
119 MOVE 2,PNBP
120 GTJFN ;GET A JFN FOR OLD FILE NAMES
121 014 158 IOJRST 0,RENAM6
122 PUSH P,1
123 SETZ AR1, ;GO RENAME THE FILE, RETURNING TO RENAM3
124 014 039 JRST RENAM0
125 RENAM3:
126 ] ;END OF IFN D20
127 PUSHJ P,6BTNML ;RETURN VALUE IS NAMELIST
128 014 084 JRST RENAM1
129
130 IFN ITS,[
131 RENAM7: SETZ
132 SIXBIT \RENMWO\ ;RENAME WHILE OPEN
133 ,,F.CHAN(TT) ;CHANNEL #
134 ,,-1(FXP) ;NEW FILE NAME 1
135 400000,,(FXP) ;NEW FILE NAME 2
136
137 RENAM8: SETZ
138 SIXBIT \RENAME\ ;RENAME
139 ,,-7(FXP) ;DEVICE NAME
140 ,,-5(FXP) ;OLD FILE NAME 1
141 ,,-4(FXP) ;OLD FILE NAME 2
142 ,,-6(FXP) ;SNAME
143 ,,-1(FXP) ;NEW FILE NAME 1
144 400000,,(FXP) ;NEW FILE NAME 2
145 ] ;END OF IFN ITS
146
147 IFN D20,[
148 RENAM4: RLJFN ? WARN [ARE AC'S OKAY HERE?]
149 HALT
150 RENAM5: MOVE 1,T
151 RLJFN
152 HALT
153 ] ;END OF IFN D20
154 IFN D10,[
155 014 169 RENAM4: SKIPA C,[NSDERR]
156 RENAM5: RELEASE TMPC,
157 ] ;END OF IFN D10
158 RENAM6: PUSHJ P,CZECHI
159 RENAM9: PUSHJ P,6BTNML ;ERROR MESSAGE IS IN C
RENAMEF FUNCTION, CNAMEF FUNCTION QIO[NEW,LSP] 09/18/78 Page 14.3
160 PUSHJ P,NCONS
161 PUSH P,A
162 PUSHJ P,6BTNML
163 POP P,B
164 PUSHJ P,CONS
165 MOVEI B,Q$RENAMEF
166 XCIOL: PUSHJ P,XCONS ;XCONS, THEN IOL
167 %IOL (C)
168
169 10$ NSDERR: SIXBIT \NO SUCH DEVICE!\
170
171 IFN ITS,[
172 RFNAME: SETZ
173 014 172 SIXBIT \RFNAME\ ;READ FILE NAMES
174 ,,F.CHAN(TT) ;CHANNEL #
175 2000,,F.RDEV(TT) ;DEVICE NAME
176 2000,,F.RFN1(TT) ;FILE NAME 1
177 2000,,F.RFN2(TT) ;FILE NAME 2
178 402000,,F.RSNM(TT) ;SNAME
179 ] ;END OF IFN ITS
180
181 CNAMEF: PUSHJ P,2MERGE ;LEAVES FIRST ARG IN AR1
182 004 008 JSP TT,XFILEP
183 014 200 JRST CNAME1
184 MOVE TT,TTSAR(AR1)
185 TLNN TT,TTS.CL ;FILE-ARRAY MUST BE CLOSED
186 014 199 JRST CNAME2
187 ADDI TT,L.F6BT
188 MOVEI F,L.F6BT ;COUNTER TO TRANSFER WORDS
189 CNAME3: MOVE T,(FXP)
190 MOVEM T,F.DEV-1(TT)
191 20% POP FXP,F.RDEV-1(TT)
192 SUBI TT,1
193 014 189 SOJG F,CNAME3
194 POPI FXP,L.F6BT
195 20$ POPI FXP,L.F6BT
196 MOVEI A,(AR1)
197 POPJ P,
198
199 014 212 CNAME2: SKIPA C,[CNAER2]
200 014 211 CNAME1: MOVEI C,CNAER1
201 CNAMER: PUSHJ P,6BTNML ;ERROR MESSAGE IS IN C
202 PUSHJ P,NCONS
203 PUSH P,A
204 PUSHJ P,6BTNML
205 POP P,B
206 PUSHJ P,CONS
207 MOVEI B,QCNAMEF
208 PUSHJ P,XCONS ;XCONS, THEN IOL
209 %IOL (C)
210
211 CNAER1: SIXBIT/NOT FILE ARRAY!/
212 CNAER2: SIXBIT/FILE ARRAY NOT CLOSED!/
DELETEF FUNCTION QIO[NEW,LSP] 09/18/78 Page 15
001 SUBTTL DELETEF FUNCTION
002
003 ;;; (DELETEF X) DELETES THE FILE X. (THAT SOUNDS LOGICAL...)
004
005 $DELETEF: ;SUBR 1
006 004 005 JSP TT,AFOSP ;SKIP IF FILE OR SFA
007 015 058 JRST $DEL3
008 IFN SFA,[
009 015 013 JRST $DELNS ;A FILE, NOT AN SFA
010 MOVEI B,Q$DELETE ;DELETE OPERATION
011 SETZ C, ;NO OP SPECIFIC ARG
012 047 133 JRST ISTCSH ;FAST INTERNAL SFA CALL
013 $DELNS: ] ;END IFN SFA
014 MOVE TT,TTSAR(A)
015 TLNE TT,TTS.CL ;SKIP IF OPEN
016 015 058 JRST $DEL3
017 HLLOS NOQUIT
018 IFN ITS,[
019 015 053 .CALL $DEL6 ;USE DELEWO FOR AN OPEN FILE
020 015 114 IOJRST 0,$DEL9A
021 016 050 PUSHJ P,JCLOSE
022 MOVE T,F.CHAN(TT) ;CHANNEL INTO T FOR CLOSE9
023 016 044 .CALL CLOSE9 ;ACTUALLY PERFORM THE CLOSE
024 .LOSE 1400
025 ] ;END OF IFN ITS
026 IFN D10,[
027 MOVE F,F.CHAN(TT)
028 MOVE R,F.RPPN(TT)
029 LSH F,27
030 IOR F,[RENAME 0,T]
031 SETZB T,TT
032 XCT F
033 015 114 IOJRST 0,$DEL9A
034 016 050 PUSHJ P,JCLOSE
035 XOR F,[<CLOSE 0,40>#<RENAME 0,T>]
036 XCT F ;40 BIT MEANS AVOID SUPERSEDING A FILE
037 XOR F,[<RELEASE 0,0>#<CLOSE 0,40>]
038 XCT F
039 ] ;END OF IFN D10
040 IFN D20,[
041 HRRZ 1,F.JFN(TT)
042 HRLI 1,(CO%NRJ) ;DON'T RELEASE JFN
043 016 050 PUSHJ P,JCLOSE
044 CLOSF
045 015 114 IOJRST 0,$DEL9A
046 TLZ 1,-1
047 DELF
048 015 114 IOJRST 0,$DEL9A
049 ] ;END OF IFN D20
050 JRST CZECHI
051
052 IFN ITS,[
053 $DEL6: SETZ
DELETEF FUNCTION QIO[NEW,LSP] 09/18/78 Page 15.1
054 SIXBIT \DELEWO\ ;DELETE WHILE OPEN
055 400000,,F.CHAN(TT) ;CHANNEL #
056 ] ;END OF IFN ITS
057
058 011 018 $DEL3: PUSHJ P,FIL6BT
059 012 028 PUSHJ P,DMRGF ;MERGE ARG WITH DEFAULTS
060 IFN ITS,[
061 015 097 .CALL $DEL7
062 015 113 IOJRST 0,$DEL9
063 ] ;END OF IFN ITS
064 IFN D10,[
065 MOVEI T,.IODMP
066 MOVE TT,-3(FXP) ;GET DEVICE NAME
067 SETZ D,
068 OPEN TMPC,T ;OPEN TEMP DUMP MODE CHANNEL
069 015 110 JRST $DEL4
070 MOVE T,-1(FXP) ;FILE NAME
071 HLLZ TT,(FXP) ;EXTENSION
072 SETZ D,
073 MOVE R,-2(FXP) ;PPN
074 LOOKUP TMPC,T
075 015 106 IOJRST 0,$DEL5
076 SETZB T,TT ;ZERO FILE NAMES MEANS DELETE
077 MOVE R,-2(FXP) ;MUST SPECIFY CORRECT PPN
078 RENAME TMPC,T ;DELETE THE FILE
079 015 106 IOJRST 0,$DEL5
080 RELEASE TMPC, ;RELEASE TEMP CHANNEL
081 ] ;END OF IFN D10
082 IFN D20,[
083 PUSH P,[-1] ;SAY LONG NAMESTRING
084 008 021 PUSHJ P,X6BTNS ;GET NAMESTRING FOR FILE IN PNBUF
085 POPI P,1
086 MOVE 1,[GJ%OLD+GJ%ACC+GJ%SHT,,.GJLEG]
087 MOVE 2,PNBP
088 GTJFN ;GET A JFN FOR THE FILE
089 015 113 IOJRST 0,$DEL9
090 TLZ 1,-1
091 DELF ;DELETE IT
092 015 106 IOJRST 0,$DEL5
093 ] ;END OF IFN D20
094 JRST 6BTNML
095
096 IFN ITS,[
097 $DEL7: SETZ
098 SIXBIT \DELETE\ ;DELETE FILE
099 ,,-3(FXP) ;DEVICE NAME
100 ,,-1(FXP) ;FILE NAME 1
101 ,,0(FXP) ;FILE NAME 2
102 400000,,-2(FXP) ;SNAME
103 ] ;END OF IFN ITS
104
105 IFN D20,[
106 $DEL5: RLJFN ;RELEASE THE TEMP JFN
DELETEF FUNCTION QIO[NEW,LSP] 09/18/78 Page 15.2
107 HALT
108 ] ;END OF IFN D20
109 IFN D10,[
110 014 169 $DEL4: SKIPA C,[NSDERR]
111 $DEL5: RELEASE TMPC, ;RELEASE THE TEMP CHANNEL
112 ] ;END OF IFN D10
113 $DEL9: PUSHJ P,6BTNML
114 $DEL9A: PUSHJ P,CZECHI
115 PUSHJ P,ACONS
116 MOVEI B,Q$DELETEF
117 014 166 JRST XCIOL
CLOSE FUNCTION QIO[NEW,LSP] 09/18/78 Page 16
001 SUBTTL CLOSE FUNCTION
002
003 ;;; (CLOSE X) CLOSES THE FILE ARRAY X. THE ARRAY ITSELF
004 ;;; IS *NOT* FLUSHED - MAY WANT TO RE-OPEN IT.
005
006 CLOSE0:
007 SFA% WTA [NOT FILE - CLOSE!]
008 SFA$ WTA [NOT FILE OR SFA - CLOSE!]
009 004 005 $CLOSE: JSP TT,AFOSP ;LEAVES OBJECT IN A
010 016 006 JRST CLOSE0 ;NOT A FILE
011 IFN SFA,[
012 016 017 JRST ICLOSE ;A FILE-ARRAY, DO INTERNAL STUFF
013 MOVEI B,Q$CLOSE ;CLOSE OPERATION
014 SETZ C, ;NO THIRD ARG
015 047 133 JRST ISTCSH ;SHORT INTERNAL SFA CALL
016 ] ;END IFN SFA
017 ICLOSE: HLLOS NOQUIT
018 MOVE TT,TTSAR(A)
019 TLNE TT,TTS.CL
020 016 041 JRST ICLOS6
021 016 050 PUSHJ P,JCLOSE
022 IFN ITS,[
023 016 044 .CALL CLOSE9 ;CLOSE FILE
024 .LOSE 1400
025 ] ;END OF IFN ITS
026 IFN D10,[
027 LSH T,27
028 SA$ IOR T,[CLOSE 0,0]
029 SA$ XCT T
030 SA$ XOR T,[<RELEASE 0,0>#<CLOSE 0,0>]
031 SA% IOR T,[RELEASE 0,0]
032 XCT T
033 ] ;END OF IFN D10
034 IFN D20,[
035 HRRZ 1,F.JFN(TT)
036 CLOSF ;DOES AN IMPLICIT RLJFN
037 JFCL
038 ] ;END OF IFN D20
039
040 SKIPA A,[TRUTH] ;RETURN T IF DID SOMETHING, ELSE NIL
041 ICLOS6: MOVEI A,NIL
042 JRST CZECHI
043
044 CLOSE9: SETZ
045 SIXBIT \CLOSE\ ;CLOSE CHANNEL
046 401000,,(T) ;CHANNEL #
047
048 ;;; FILE PRE-CLOSE CLEANUP - RETURNS CHANNEL IN T, TTSAR IN TT
049
050 JCLOSE: MOVE TT,TTSAR(A)
051 TLNE TT,TTS.CL ;SKIP UNLESS ALREADY CLOSED
052 .LOSE
053 TLNE TT,TTS.IO ;SKIP UNLESS OUTPUT FILE ARRAY
CLOSE FUNCTION QIO[NEW,LSP] 09/18/78 Page 16.1
054 017 045 PUSHJ P,IFORCE ;FORCE OUTPUT BUFFER
055 MOVE TT,TTSAR(A)
056 TLNE TT,TTS.TY
057 SKIPN T,FT.CNS(TT)
058 016 062 JRST CLOSE4
059 SETZM FT.CNS(TT) ;UNLINK TWO TTY'S WHICH
060 MOVE T,TTSAR(T) ; WERE TTYCONS'D TOGETHER
061 SETZM FT.CNS(T) ; IF ONE IS CLOSED
062 CLOSE4: HRRZ T,F.CHAN(TT)
063 MOVSI D,TTS.CL ;TURN ON "FILE CLOSED"
064 IORM D,TTSAR(A) ; BIT IN ARRAY SAR
065 SETZM CHNTB(T) ;CLEAR CHANNEL TABLE ENTRY
066 POPJ P,
FORCE-OUTPUT QIO[NEW,LSP] 09/18/78 Page 17
001 SUBTTL FORCE-OUTPUT
002
003 ;;; (FORCE-OUTPUT X) FORCES THE OUTPUT BUFFER OF OUTPUT FILE ARRAY X.
004
005 FORCE:
006 IFN SFA,[
007 EXCH AR1,A
008 004 007 JSP TT,XFOSP ;AN SFA?
009 017 016 JRST FORSF1
010 017 016 JRST FORSF1
011 EXCH AR1,A
012 011 046 JSP T,QIOSAV
013 MOVEI B,QFORCE
014 SETZ C,
015 047 133 JRST ISTCSH
016 FORSF1: EXCH AR1,A
017 ] ;END IFN SFA
018 PUSH P,AR1
019 MOVEI AR1,(A)
020 017 024 PUSHJ P,FORCE1
021 POP P,AR1
022 POPJ P,
023
024 005 006 FORCE1: PUSHJ P,OFILOK ;DOES A LOCKI
025 017 045 PUSHJ P,IFORCE
026 IFN ITS,[
027 017 035 .CALL FORCE9
028 CAIN D,%EBDDV ;"WRONG TYPE DEVICE" ERROR IS OKAY
029 CAIA
030 .VALUE ;ANY OTHER ERROR LOSES
031 ] ;END OF IFN ITS
032 JRST UNLKTRUE
033
034 IFN ITS,[
035 FORCE9: SETZ
036 017 005 SIXBIT \FORCE\ ;FORCE OUTPUT BUFFER TO DEVICE
037 ,,F.CHAN(TT) ;CHANNEL #
038 403000,,D ;ERROR #
039 ] ;END OF IFN ITS
040
041 ;;; INTERNAL OUTPUT BUFFER FORCE ROUTINE. EXPECTS USER
042 ;;; INTERRUPTS OFF, AND FILE ARRAY TTSAR IN TT.
043 ;;; CLOBBERS T, TT, D, AND F.
044
045 IFORCE: TLNE TT,TTS.CL
046 017 005 LERR [SIXBIT \CAN'T FORCE OUTPUT ON CLOSED FILE!\]
047 SKIPGE F,F.MODE(TT) .SEE FBT.CM ;CAN'T FORCE A CHARMODE FILE
048 POPJ P,
049 MOVE F,FB.BFL(TT)
050 IFN ITS,[
051 SUB F,FB.CNT(TT)
052 017 057 JUMPE F,IFORC1
053 MOVE D,F ;NUMBER OF BYTES TO TRANSFER
FORCE-OUTPUT QIO[NEW,LSP] 09/18/78 Page 17.1
054 MOVE T,FB.IBP(TT) ;INITIAL BYTE POINTER
055 017 095 .CALL SIOT ;OUTPUT THE (PARTIAL) BUFFER
056 .LOSE 1400
057 IFORC1:
058 ] ;END OF IFN ITS
059 IFN D10,[
060 MOVE T,F.CHAN(TT)
061 LSH T,27
062 IOR T,[OUT 0,0]
063 XCT T ;OUTPUT THE CURRENT BUFFER
064 CAIA
065 HALT ;? OUTPUT ERROR
066 ] ;END OF IFN D10
067 IFN D20,[
068 SUB F,FB.CNT(TT)
069 PUSHJ FXP,SAV3 ;PRESERVE ACS 1-3
070 MOVE 1,F.JFN(TT)
071 MOVE 2,FB.IBP(TT) ;INITIAL BYTE POINTER
072 MOVN 3,F ;NEGATIVE OF BYTE COUNT
073 SOUT ;OUTPUT (PARTIAL) BUFFER
074 ERJMP .+1 ;IGNORE ERRORS
075 PUSHJ FXP,RST3
076 ] ;END OF IFN D20
077 ADDM F,F.FPOS(TT) ;UPDATE FILE POSITION
078 017 082 IFN ITS+D20, JSP D,FORCE6 ;INITIALIZE POINTER AND COUNT
079 POPJ P,
080
081 IFN ITS+D20,[
082 FORCE6: MOVE T,FB.BFL(TT) ;ROUTINE TO INITIALIZE BYTE POINTER AND COUNT
083 MOVEM T,FB.CNT(TT)
084 MOVE T,FB.IBP(TT)
085 MOVEM T,FB.BP(TT)
086 JRST (D)
087 ];END IFN ITS+D20
088
089 IFN ITS,[
090 IOTTTT: SETZ
091 SIXBIT \IOT\ ;I/O TRANSFER
092 ,,F.CHAN(TT) ;CHANNEL #
093 400000,,T ;DATA POINTER (DATA?)
094
095 SIOT: SETZ
096 017 095 SIXBIT \SIOT\ ;STRING I/O TRANSFER
097 ,,F.CHAN(TT) ;CHANNEL #
098 ,,T ;BYTE POINTER
099 400000,,D ;BYTE COUNT
100 ] ;END OF IFN ITS
STATUS FILEMODE QIO[NEW,LSP] 09/18/78 Page 18
001 SUBTTL STATUS FILEMODE
002
003 ;;; (STATUS FILEMODE <FILE> ) RETURNS A LIST DESCRIBING
004 ;;; THE FILE: NIL ==> FILE HAS BEEN CLOSED; OTHERWISE
005 ;;; THE CAR OF THIS LIST IS A VALID OPTIONS
006 ;;; LIST FOR THE OPEN FUNCTION. THE CDR OF THIS LIST
007 ;;; CONTAINS INFORMATIVE ITEMS WHICH ARE NOT NECESSARILY
008 ;;; USER-SETTABLE FEATURES ABOUT THE FILE.
009 ;;; PRESENTLY SUCH GOODIES INCLUDE:
010 ;;; RUBOUT AN OUTPUT TTY THAT CAN SELECTIVELY ERASE
011 ;;; CURSORPOS AN OUTPUT TTY THAT CAN CURSORPOS WELL
012 ;;; SAIL FOR AN OUTPUT TTY, HAS SAIL CHARACTER SET
013 ;;; FILEPOS CAN FILEPOS CORRECTLY (RANDOM ACCESS)
014 ;;; NON-FILE ARGUMENT CAUSES AN ERROR.
015
016 005 048 SFMD0: %WTA NFILE
017 SFILEMODE:
018 004 005 JSP TT,AFOSP ;MUST BE A FILE OR SFA
019 018 016 JRST SFMD0
020 IFN SFA,[
021 018 034 JRST SFMD0A ;IF FILE THEN HANDLE NORMALLY
022 SETZ C, ;IF WE GO TO THE SFA, NO THIRD ARG
023 MOVEI T,SO.MOD ;CAN THE SFA DO (STATUS FILEMODE)?
024 MOVEI TT,SR.WOM
025 TDNE T,@TTSAR(A) ;CAN IT DO THE OPERATION?
026 047 125 JRST ISTCAL ;YES, CALL THE SFA AND RETURN
027 MOVEI B,QWOP ;OTHERWISE, DO A WHICH-OPERATIONS
028 047 133 PUSHJ P,ISTCSH
029 PUSH P,A ;SAVE THE RESULTS
030 MOVEI A,QSFA
031 JSP T,%NCONS ;MAKE A LIST
032 POP P,B
033 JRST CONS ;RETURN ((SFA) {WHICH-OPERATIONS})
034 SFMD0A: ] ;END IFN SFA
035 LOCKI
036 MOVE TT,TTSAR(A) ;GET TTSAR BITS
037 TLNE TT,TTS.CL ;RETURN NIL IF THE FILE IS CLOSED
038 JRST UNLKFALSE
039 MOVE R,F.FLEN(TT) ;IF LENGTH > 0 THEN BLOCK MODE, ELSE SINGLE
040 MOVEI A,QBLOCK
041 SKIPGE F,F.MODE(TT) .SEE FBT.CM
042 MOVEI A,QSINGLE
043 UNLOCKI
044 PUSHJ P,NCONS
045 MOVEI B,QDSK ;TWO MAJOR TYPES - TTY OR DSK
046 TLNE TT,TTS.TY
047 MOVEI B,QTTY
048 PUSHJ P,XCONS
049 MOVEI B,Q$ASCII ;ASCII, IMAGE, OR FIXNUM
050 TLNE TT,TTS.IM
051 MOVEI B,QIMAGE
052 TLNN TT,TTS.IO
053 TLNN TT,TTS.TY
STATUS FILEMODE QIO[NEW,LSP] 09/18/78 Page 18.1
054 018 056 JRST SFMD1
055 TLNN F,FBT.FU ;INPUT TTY: FULL CHAR SET MEANS FIXNUM FILE
056 SFMD1: TLNE TT,TTS<BN>
057 MOVEI B,QFIXNUM
058 PUSHJ P,XCONS
059 MOVEI B,Q$IN ;INPUT, OUTPUT, OR APPEND MODE
060 TLNE TT,TTS<IO>
061 MOVEI B,Q$OUT
062 TLNE F,FBT<AP>
063 MOVEI B,QAPPEND
064 PUSHJ P,XCONS
065 MOVEI B,QECHO ;OTHER RANDOM MODE BITS - ECHO
066 TLNE F,FBT.EC
067 PUSHJ P,XCONS
068 MOVEI B,QSCROLL ;SCROLL
069 TLNE F,FBT.SC
070 PUSHJ P,XCONS
071 MOVEI C,(A)
072 SETZ A,
073 MOVEI B,QSAIL
074 TLNE F,FBT.SA ;SAIL MODE
075 PUSHJ P,XCONS
076 MOVEI B,QRUBOUT
077 TLNE F,FBT.SE ;RUBOUT-ABLE
078 PUSHJ P,XCONS
079 10% MOVEI B,QCURSORPOS ;CURSORPOS-ABLE
080 10% TLNE F,FBT.CP
081 10% PUSHJ P,XCONS
082 MOVEI B,QFILEPOS ;FILEPOS-ABLE
083 SKIPL R .SEE F.FLEN ;NEGATIVE => CAN'T FILEPOS
084 PUSHJ P,XCONS
085 MOVEI B,(C)
086 JRST XCONS
LOAD FUNCTION QIO[NEW,LSP] 09/18/78 Page 19
001 SUBTTL LOAD FUNCTION
002 ;;; (LOAD FOO) LOADS THE FILE FOO. IT FIRST PROBEF'S TO
003 ;;; ASCERTAIN THE EXISTENCE OF THE FILE, AND CHECKS THE FIRST
004 ;;; WORD TO SEE WHETHER IT IS AN ASCII OR FASL FILE.
005 ;;; IF NO SECOND FILE NAME IS GIVEN, "FASL" IS TRIED FIRST,
006 ;;; AND THEN ">" IF NO FASL FILE EXISTS.
007 ;;; IF A FASL FILE, IT GIVES THE FILE NAMES TO FASLOAD.
008 ;;; IF AN ASCII FILE, IT IS OPENED, (INFILE ↑Q, *, +, -, INSTACK)
009 ;;; BOUND TO (<THE FILE>, T, *, +, -, NIL), AND A READ-EVAL
010 ;;; LOOP PERFORMED UNTIL END OF FILE OCCURS LEAVING INSTACK=NIL
011 ;;; AND INFILE=T.
012
013 LOAD: JUMPE A,CPOPJ ;IF GIVEN NIL AS ARG, RETURN NIL
014 011 018 PUSHJ P,FIL6BT ;SUBR 1
015 20$ MOVE F,-L.6EXT-L.6VRS+1(FXP)
016 20% MOVS F,(FXP)
017 012 028 PUSHJ P,DMRGF ;DMRGF SAVES F
018 LOCKI
019 20% CAIE F,(SIXBIT \*\)
020 019 071 JUMPN F,LOAD3
021 IFN ITS+D10, MOVE TT,[SIXBIT \FASL\]
022 IT$ MOVEM TT,-1(FXP)
023 10$ HLLZM TT,-1(FXP)
024 20$ MOVE TT,[ASCII \FASL\]
025 20$ MOVEM TT,-L.6EXT-L.6VRS+1(FXP)
026 019 117 JSP T,FASLP1
027 019 063 JRST LOAD1 ;FILE NOT FOUND
028 019 077 JRST LOAD2 ;FASL FILE
029 LOAD5: UNLOCKI ;EXPR FILE FOUND
030 PUSHJ P,6BTNML
031 019 035 PUSH P,[LOAD6]
032 PUSH P,A
033 MOVNI T,1
034 021 001 JRST $EOPEN ;OPEN AS A FILE OBJECT
035 LOAD6: HRRZ B,VIPLUS ;WE WANT +, -, * TO WORK AS FOR TOP LEVEL,
036 HRRZ C,V. ; BUT NOT SCREW THE OUTSIDE WORLD
037 HRRZ AR1,VIDIFFERENCE
038 MOVEI AR2A,TRUTH
039 JSP T,SPECBIND
040 0 A,VINFILE
041 0 B,VIPLUS
042 0 C,V.
043 0 AR1,VIDIFFERENCE
044 0 AR2A,TAPRED
045 VINSTACK
046 019 050 JRST LOAD7A
047
048 LOAD7: PUSHJ P,TLEVAL ;USE THE EVAL PART OF THE TOP LEVEL
049 HRRZM A,V.
050 LOAD7A:
051 019 054 REPEAT 2, PUSH P,[LOAD8] ;ONCE FOR RANDOM EOF VALUE
052 MOVNI T,1
053 JRST IREAD1
LOAD FUNCTION QIO[NEW,LSP] 09/18/78 Page 19.1
054 LOAD8: CAIE A,LOAD8
055 019 048 JRST LOAD7
056 HRRZ B,VINFILE
057 SKIPN VINSTACK
058 CAIE B,TRUTH
059 019 050 JRST LOAD7A
060 PUSHJ P,UNBIND
061 JRST TRUE
062
063 LOAD1:
064 IT$ MOVSI TT,(SIXBIT \>\) ;OTHERWISE TRY ">"
065 10$ MOVSI TT,(SIXBIT \LSP\) ;FOR D10, "LSP"
066 20% MOVEM TT,-1(FXP)
067 20$ MOVSI TT,[ASCIZ \MACLISP\]
068 20$ HRRI TT,-L.6EXT-L.6VRS(FXP) ;REMEMBER ADJUSTMENT FOR LOCKI WORD
069 20$ BLT TT,-L.6EXT-L.6VRS+1(FXP)
070 MOVEM TT,-1(FXP)
071 LOAD3: MOVEI A,QLOAD
072 019 117 JSP T,FASLP1
073 019 085 JRST LOAD4 ;LOSE COMPLETELY
074 019 077 JRST LOAD2 ;FASL FILE
075 019 029 JRST LOAD5 ;EXPR CODE
076
077 LOAD2: UNLOCKI ;FASL FILE - GO FASLOAD IT
078 PUSHJ P,6BTNML
079 HRRZ B,VDEFAULTF
080 JSP T,SPECBIND
081 0 B,VDEFAULTF ;DON'T LET FASLOAD CLOBBER DEFAULTF
082 PUSHJ P,FASLOAD
083 JRST UNBIND
084
085 LOAD4: IOJRST 0,.+1
086 PUSH P,A
087 UNLOCKI
088 PUSHJ P,6BTNML ;LOSEY LOSEY
089 PUSHJ P,NCONS
090 POP P,B
091 014 166 JRST XCIOL
092
093
094 ;;; (FASLP <FILE>) TELLS WHETHER THE FILE IS A FASL FILE.
095 ;;; ERROR IF FILE DOES NOT EXIST.
096
097 011 018 $FASLP: PUSHJ P,FIL6BT
098 012 028 PUSHJ P,DMRGF
099 MOVEI A,Q$FASLP
100 LOCKI
101 019 117 JSP T,FASLP1
102 019 085 JRST LOAD4
103 SKIPA A,[TRUTH]
104 MOVEI A,NIL
105 UNLOCKI
106 SUB FXP,R70+4
LOAD FUNCTION QIO[NEW,LSP] 09/18/78 Page 19.2
107 POPJ P,
108
109 ;;; ROUTINE TO TEST A FILE FOR FASL-NESS.
110 ;;; JSP T,FASLP1
111 ;;; JRST NOTFOUND ;FILE NOT FOUND, OR OTHER ERROR
112 ;;; JRST FASL ;FILE IS A FASL FILE
113 ;;; ... ;FILE IS NOT A FASL FILE
114 ;;; FXP MUST HOLD THE "SIXBIT" FILE NAMES, WITH A LOCKI WORD ABOVE THEM.
115 ;;; USER INTERRUPTS MUST BE LOCKED OUT.
116
117 FASLP1:
118 IFN ITS,[
119 019 189 .CALL FASLP9 ;OPEN FILE ON TEMP CHANNEL
120 JRST (T)
121 019 185 .CALL FASLP8 ;RESTORE REFERENCE DATE
122 JFCL ; (ONLY WORKS FOR DISK CHANNELS - IGNORE FAILURE)
123 HRROI D,TT
124 .IOT TMPC,D ;READ FIRST WORD
125 .CLOSE TMPC,
126 JUMPL D,2(T) ;NOT A FASL FILE IF ZERO-LENGTH
127 ] ;END OF IFN ITS
128 IFN D10,[
129 PUSH P,T
130 MOVEI T,.IODMP
131 MOVE TT,-4(FXP)
132 SETZ D,
133 OPEN TMPC,T ;OPEN TEMP CHANNEL TO FILE
134 POPJ P,
135 MOVE T,-2(FXP) ;FILE NAME
136 HLLZ TT,-1(FXP) ;EXTENSION
137 SETZ D,
138 MOVE R,-3(FXP) ;PPN
139 LOOKUP TMPC,T ;LOOK UP FILE NAMES
140 019 174 JRST FASLP2
141 SETZB TT,R
142 PUSH FXP,NIL ;USE A WORD ON FXP AS D10 CAN'T DO I/O TO AC'S
143 HRROI D,-1(FXP) ;D AND R ARE THE DUMP MODE COMMAND LIST
144 INPUT TMPC,D ;GET FIRST WORD OF FILE
145 SA% CLOSE TMPC,CL.ACS ;DON'T UPDATE ACCESS DATE
146 RELEASE TMPC,
147 POP FXP,TT ;GET THE WORD READ FROM THE FILE
148 POP P,T
149 013 025 SA$ WARN [RESTORE REF DATE FOR SAIL PROBEF?]
150 ;FALLS THROUGH
151 ] ;END OF IFN D10
152 IFN D20,[
153 PUSH FLP,(FXP) ;SAVE THE LOCKI WORD, BUT OFF FXP
154 POPI FXP,1
155 PUSH P,T
156 PUSH P,[-1] ;SASY LONG NAMESTRING
157 008 021 PUSHJ P,X6BTNS ;GET NAMESTRING IN PNBUF
158 POPI P,1
159 PUSH FXP,(FLP) ;PUT LOCKI WORD BACK IN ITS PLACE
LOAD FUNCTION QIO[NEW,LSP] 09/18/78 Page 19.3
160 POPI FLP,1
161 MOVSI 1,(GJ%OLD+GJ%ACC+GJ%SHT) .SEE .GJDEF
162 MOVE 2,PNBP
163 GTJFN ;GET A JFN FOR THE FILE NAME
164 POPJ P,
165 MOVE 2,[440000,,OF%RD+OF%PDT] .SEE OF%BSZ OF%MOD
166 SETZ TT,
167 OPENF ;OPEN FILE, PRESERVING ACCESS DATE
168 019 174 JRST FASLP2
169 BIN ;GET ONE 36.-BIT BYTE
170 MOVE TT,2
171 CLOSF ;CLOSE THE FILE
172 JFCL ;IGNORE ERROR RETURN
173 SKIPA ;JFN HAS BEEN RELEASED BY THE CLOSE
174 FASLP2: RLJFN ;RELEASE THE JFN
175 JFCL
176 SETZB 1,2 ;CLEAR OUT CRUD IN 1 AND 2
177 POP P,T
178 ] ;END OF IFN D20
179 TRZ TT,1
180 CAMN TT,[SIXBIT \*FASL*\]
181 JRST 1(T) ;FASL FILE IF FIRST WORD CHECKS
182 JRST 2(T)
183
184 IFN ITS,[
185 FASLP8: SETZ
186 SIXBIT \RESRDT\ ;RESTORE REFERENCE DATE
187 401000,,TMPC ;CHANNEL #
188
189 FASLP9: SETZ
190 SIXBIT \OPEN\ ;OPEN FILE
191 5000,,6 ;IMAGE BLOCK INPUT
192 1000,,TMPC ;CHANNEL NUMBER
193 ,,-4(FXP) ;DEVICE NAME
194 ,,-2(FXP) ;FILE NAME 1
195 ,,-1(FXP) ;FILE NAME 2
196 400000,,-3(FXP) ;SNAME
197 ] ;END OF IFN ITS
198
199 IFN D10,[
200 FASLP2: RELEASE TMPC,
201 POPJ P,
202 ]
203
204 ;;; (DEFUN INCLUDE FEXPR (X)
205 ;;; ((LAMBDA (F)
206 ;;; (EOFFN F '+INTERNAL-INCLUDE-EOFFN)
207 ;;; (INPUSH F))
208 ;;; (OPEN (CAR X))))
209
210 INCLUDE:
211 HLRZ A,(A) ;FSUBR
212 019 216 PUSH P,[INCLU1]
LOAD FUNCTION QIO[NEW,LSP] 09/18/78 Page 19.4
213 PUSH P,A
214 MOVNI T,1
215 021 001 JRST $EOPEN
216 INCLU1: MOVEI TT,FI.EOF
217 MOVEI B,QINCEOF
218 MOVEM B,@TTSAR(A)
219 JRST INPUSH
220
221 INCEOF==:FALSE ;INCLUDE'S EOF FUNCTION - SUBR 2
OPEN FUNCTION (INCLUDING SAIL EOPEN) QIO[NEW,LSP] 09/18/78 Page 20
001 SUBTTL OPEN FUNCTION (INCLUDING SAIL EOPEN)
002
003 ;;; (OPEN <FILE> <MODELIST>) OPENS A FILE AND RETURNS A
004 ;;; CORRESPONDING FILE OBJECT. IT IS ACTUALLY AN LSUBR
005 ;;; OF ZERO TO TWO ARGUMENTS. THE <FILE> DEFAULTS TO THE
006 ;;; CURRENT DEFAULT FILE NAMES. THE <MODELIST> DEFAULTS
007 ;;; TO NIL.
008 ;;; IF <FILE> IS A NAMELIST OR NAMESTRING, A NEW FILE ARRAY
009 ;;; IS CREATED. IF <FILE> IS A FILE ARRAY ALREADY, IT IS
010 ;;; CLOSED AND RE-OPENED IN THE SPECIFIED MODE; ITS FORMER
011 ;;; MODES SERVE AS THE DEFAULTS FOR THE <MODELIST>.
012 ;;; THE <MODELIST> DETERMINES A LARGE NUMBER OF ATTRIBUTES
013 ;;; FOR OPENING THE FILE. FOR EACH ATTRIBUTE THERE ARE
014 ;;; TWO OR MORE MUTUALLY EXCLUSIVE VALUES WHICH MAY BE
015 ;;; SPECIFIED AS FOLLOWS. VALUES MARKED BY A * ARE THOSE
016 ;;; USED AS DEFAULTS WHEN THE <FILE> IS A NAMELIST OR
017 ;;; NAMESTRING. IF THE <MODELIST> IS AN ATOM, IT IS THE
018 ;;; SAME AS SPECIFYING THE LIST OF THAT ONE ATOM.
019 ;;; DIRECTION:
020 ;;; * IN INPUT FILE
021 ;;; * READ SAME AS "IN"
022 ;;; OUT OUTPUT FILE
023 ;;; PRINT SAME AS "OUT"
024 ;;; APPEND OUTPUT, APPENDED TO EXISTING FILE
025 ;;; DATA MODE:
026 ;;; * ASCII FILE IS A STREAM OF ASCII CHARACTERS.
027 ;;; SYSTEM-DEPENDENT TRANSFORMATIONS MAY
028 ;;; OCCUR, SUCH AS SUPPLYING LF AFTER CR,
029 ;;; OR BEING CAREFUL WITH OUTPUT OF ↑P,
030 ;;; OR MULTICS ESCAPE CONVENTIONS.
031 ;;; FIXNUM FILE IS A STREAM OF FIXNUMS. THIS
032 ;;; IS FOR DEALING WITH FILES THOUGHT OF
033 ;;; AS "BINARY" RATHER THAN "CHARACTER".
034 ;;; FOR TTY'S, THIS IS INTERPRETED AS
035 ;;; "MORE-THAN-ASCII" OR "FULL CHARACTER
036 ;;; SET" MODE, WHICH READS 9 BITS AT SAIL
037 ;;; AND 12. ON ITS.
038 ;;; IMAGE FILE IS A STREAM OF ASCII CHARACTERS.
039 ;;; ABSOLUTELY NO TRANSFORMATIONS ARE MADE.
040 ;;; DEVICE TYPE:
041 ;;; * DSK STANDARD KIND OF FILE.
042 ;;; CLA (ITS ONLY) LIKE DSK, BUT REQUIRES BLOCK MODE,
043 ;;; AND GOBBLES THE FIRST TWO WORDS, INSTALLING
044 ;;; THEM IN THE TRUENAME. USEFUL PRIMARILY FOR
045 ;;; A CLI-MESSAGE INTERRUPT FUNCTION.
046 ;;; TTY CONSOLE. IN PARTICULAR, ONLY TTY INPUT
047 ;;; FILES HAVE INTERRUPT CHARACTER FUNCTIONS
048 ;;; ASSOCIATED WITH THEM.
049 ;;; BUFFERING MODE:
050 ;;; * BLOCK DATA IS BUFFERED.
051 ;;; SINGLE DATA IS UNBUFFERED.
052 ;;; PRINTING AREA:
053 ;;; ECHO (ITS ONLY) OPEN TTY IN ECHO AREA
OPEN FUNCTION (INCLUDING SAIL EOPEN) QIO[NEW,LSP] 09/18/78 Page 20.1
054 ;;; SOME OF THESE VALUES ARE OF COURSE SYSTEM-DEPENDENT.
055 ;;; YOUR LOCAL LISP SYSTEM WILL ATTEMPT TO DO THE RIGHT THING,
056 ;;; HOWEVER, IN ANY CASE.
057 ;;; IF THE OPTIONS LIST IS INVALID IN ANY WAY, OPEN MAY EITHER
058 ;;; GIVE A WRNG-TYPE-ARGS ERROR, OR BLITHELY ASSUME A CORRECTED
059 ;;; VALUE FOR AN ATTRIBUTE. IN GENERAL, ERRORS SHOULD OCCUR
060 ;;; ONLY FOR TRULY CONFLICTING SPECIFICATIONS. ON THE OTHER
061 ;;; HAND, SPECIFYING BLOCK MODE FOR A DEVICE THAT THE SYSTEM
062 ;;; WANTS TO HANDLE ONLY IN CHARACTER MODE WILL JUST GO AHEAD
063 ;;; AND USE CHARACTER MODE. IN GENERAL, ONE SHOULD USE
064 ;;; (STATUS FILEMODE) TO SEE HOW THE FILE WAS ACTUALLY OPENED.
OPEN FUNCTION (INCLUDING SAIL EOPEN) QIO[NEW,LSP] 09/18/78 Page 21
001 SA% $EOPEN:
002 $OPEN: MOVEI D,Q$OPEN ;LSUBR (0 . 2)
003 CAMGE T,XC-2
004 JRST WNALOSE
005 SETZB A,B ;BOTH ARGUMENTS DEFAULT TO NIL
006 CAMN T,XC-2
007 POP P,B
008 SKIPE T
009 POP P,A
010 IFN SFA,[
011 004 005 JSP TT,AFOSP ;WERE WE HANDED AN SFA AS FIRST ARG?
012 JFCL
013 021 017 JRST $OPNNS ;NOPE, CONTINUE AS USUAL
014 MOVEI C,(B) ;ARG TO SFA IS THE LIST GIVEN TO OPEN
015 MOVEI B,Q$OPEN ;OPERATION
016 047 133 JRST ISTCSH ;SHORT INTERNAL CALL
017 $OPNNS: ] ;END IFN SFA
018 ;THE TWO ARGUMENTS ARE NOW IN A AND B.
019 ;WE NOW PARSE THE OPTIONS LIST. F WILL HOLD OPTION VALUES,
020 ; AND D WILL INDICATE WHICH WERE SPECIFIED EXPLICITLY BY THE USER.
021 OPEN0J: PUSH P,T ;SAVE NUMBER OF ARGS ON P (NOT FXP!)
022 SETZB D,F
023 004 006 JSP TT,AFILEP ;IS THE FIRST ARGUMENT A FILE OBJECT?
024 021 029 JRST OPEN1A
025 MOVEI TT,F.MODE
026 MOVE F,@TTSAR(A) ;IF SO, USE ITS MODE AS THE DEFAULTS
027 IT$ SKIPE B ;MAKE CHUCK RICH HAPPY - DON'T LET "ECHO" CARRY
028 IT$ TLZ F,FBT.EC+FBT.CP+FBT.SC ; OVER IF A NON-NULL OPTIONS LIST WAS GIVEN
029 023 017 OPEN1A: JUMPE B,OPEN1Y ;JUMP OUT IF NO OPTIONS SUPPLIED
030 MOVEI C,(B)
031 MOVEI TT,(B)
032 LSH TT,-SEGLOG
033 SKIPG ST(TT)
034 021 037 JRST OPEN1C
035 MOVSI AR2A,(B) ;IF A SINGLE, ATOMIC OPTION WAS GIVEN, AR2A
036 MOVEI C,AR2A ; IS A FAKE CONS CELL SO IT LOOKS LIKE A LIST
037 023 013 OPEN1C: JUMPE C,OPEN1L ;JUMP OUT IF LAST OPTION PROCESSED
038 HLRZ AR1,(C)
039 021 048 OPN1F1: JUMPE AR1,OPEN1G ;IGNORE NIL AS A KEYWORD
040 022 019 MOVSI TT,-LOPMDS
041 022 004 OPEN1F: HRRZ R,OPMDS(TT) ;COMPARE GIVEN OPTION AGAINST VALID ONES
042 CAIN AR1,(R)
043 021 051 JRST OPEN1K ;JUMP ON MATCH
044 021 041 AOBJN TT,OPEN1F
045 EXCH A,AR1 ;ERRONEOUS KEYWORD INTO AR1
046 WTA [IS ILLEGAL KEYWORD - OPEN!]
047 EXCH A,AR1
048 OPEN1G: HRRZ C,(C) ;CDR DOWN LIST UNTIL ALL DONE
049 021 037 JRST OPEN1C
050
051 022 004 OPEN1K: TDNN D,OPMDS(TT) ;SEE IF THERE IS A CONFLICT
052 021 058 JRST OPEN1Z
053 OPEN1H: EXCH A,B
OPEN FUNCTION (INCLUDING SAIL EOPEN) QIO[NEW,LSP] 09/18/78 Page 21.1
054 WTA [ILLEGAL OPTIONS LIST - OPEN!]
055 EXCH A,B
056 021 021 JRST OPEN0J
057
058 022 004 OPEN1Z: HLRZ R,OPMDS(TT)
059 TLO D,(R)
060 TLZ F,(R)
061 TRZ F,(R)
062 022 023 IOR F,OPBITS(TT)
063 021 048 JRST OPEN1G
OPEN FUNCTION (INCLUDING SAIL EOPEN) QIO[NEW,LSP] 09/18/78 Page 22
001 ;;; LEFT HALF IS SET OF MODE BITS WHICH THE OPTION IN THE RIGHT
002 ;;; HALF WILL CONFLICT WITH IF ANY ONE ELSE SELECTS THEM.
003
004 OPMDS: FBT.AP+1,,Q$IN
005 FBT.AP+1,,QOREAD
006 FBT.AP+1,,Q$OUT
007 FBT.AP+1,,Q%PRINT
008 FBT.AP+1,,QAPPEND
009 000014,,Q$ASCII
010 000014,,QFIXNUM
011 000014,,QIMAGE
012 000002,,QDSK
013 IT$ FBT.CA+2,,QCLA
014 000002,,QTTY
015 FBT.CM,,QBLOCK
016 FBT.CM,,QSINGLE
017 IT$ FBT.EC,,QECHO
018 IT$ FBT.SC,,QSCROLL
019 022 004 LOPMDS==.-OPMDS
020
021 ;;; MODE BITS ACTUALLY TO BE SET FOR AN OPTION IN THE OPMDS TABLE.
022
023 OPBITS: 0 ;IN
024 0 ;READ
025 1 ;OUT
026 1 ;PRINT
027 FBT.AP,,1 ;APPEND
028 0 ;ASCII
029 4 ;FIXNUM
030 10 ;IMAGE
031 0 ;DSK
032 IT$ FBT.CA,,0 ;CLA
033 2 ;TTY
034 0 ;BLOCK
035 FBT.CM,, ;SINGLE
036 IT$ FBT.EC,, ;ECHO
037 IT$ FBT.SC,, ;SCROLL
038 022 023 TBLCHK OPBITS,LOPMDS
OPEN FUNCTION (INCLUDING SAIL EOPEN) QIO[NEW,LSP] 09/18/78 Page 23
001 ;STATE OF THE WORLD:
002 ; FIRST ARG TO OPEN IN A
003 ; SECOND ARG IN B
004 ; D CONTAINS BITS FOR ACTUALLY SPECIFIED OPTIONS IN LEFT HALF
005 ; F CONTAINS BITS FOR OPTIONS
006 .SEE FBT.CM ;AND FRIENDS
007 ; 1.4-1.3 0 => ASCII, 1 => FIXNUM, 2 => IMAGE
008 ; 1.2 0 => DSK, 1 => TTY
009 ; 1.1 0 => IN, 1 => OUT
010 ; BITS 1.4-1.1 ARE USED TO INDEX VARIOUS TABLES LATER
011 ; ACTUAL NUMBER OF ARGS ON P
012 ;WE NOW EMBARK ON DEFAULTING AND MAKING CONSISTENT THE VARIOUS MODES
013 OPEN1L: TLNE D,FBT.CM ;SKIP IF SINGLE VS. BLOCK WAS UNSPECIFIED
014 023 017 JRST OPEN1Y
015 TRNE F,2 ;SKIP UNLESS TTY
016 TLO F,FBT.CM ;FOR TTY, DEFAULT TO SINGLE, NOT BLOCK, MODE
017 OPEN1Y:
018 IT$ TRC F,3
019 IT$ TRCE F,3
020 IT$ TLZ F,FBT.EC+FBT.SC ;ECHO AND SCROLL MEANINGFUL ONLY FOR TTY OUTPUT
021 TRNN F,2 ;SKIP IF TTY
022 023 029 JRST OPEN1S
023 TLZ F,FBT.AP ;CAN'T APPEND TO A TTY
024 TRNN F,1
025 TLO F,FBT.CM ;CAN'T DO BLOCK TTY INPUT
026 TRNE F,4 ;FIXNUM TTY I/O USES FULL CHAR SET
027 TLO F,FBT.FU
028 ;NOW WORRY ABOUT FILE NAMES AND ALLOCATING A FILE OBJECT
029 OPEN1S: PUSH P,A
030 PUSH P,B
031 PUSH FXP,F
032 CAIE A,TRUTH ;T MEANS TTY FILE ARRAY...
033 023 037 JRST OPEN1M
034 TRNN F,1
035 SKIPA A,V%TYI ;TTY INPUT IF MODE BITS SAY INPUT
036 HRRZ A,V%TYO ; AND OUTPUT OTHERWISE
037 OPEN1M: PUSH P,A
038 011 018 PUSHJ P,FIL6BT ;GET FILE NAME SPECS
039 012 028 PUSHJ P,DMRGF ;MERGE IN DEFAULT NAMES
040 MOVE A,(P) ;GET (POSSIBLY MUNGED FOR T) FIRST ARG
041 004 006 JSP TT,AFILEP ;SKIP IF WE GOT A REAL LIVE SAR
042 023 056 JRST OPEN1N
043 016 017 PUSHJ P,ICLOSE ;CLOSE IT IF NECESSARY
044 20$ WARN [SHOULD WE RELEASE THE JFN AT THIS POINT?]
045 MOVE A,(P)
046 MOVE D,-3(P) ;IF ONLY ONE ARG TO OPEN, AND
047 023 106 AOJE D,OPEN1Q ; THAT A SAR, RE-USE THE ARRAY
048 MOVE F,-L.F6BT(FXP)
049 MOVEI TT,F.MODE
050 XOR F,@TTSAR(A)
051 TDNE F,[FBT.CM,,17]
052 023 058 JRST OPEN1P
053 PUSHJ P,OPNCLR ;IF TWO ARGS, BUT SAME MODE,
OPEN FUNCTION (INCLUDING SAIL EOPEN) QIO[NEW,LSP] 09/18/78 Page 23.1
054 023 106 JRST OPEN1Q ; CLEAR ARRAY, THAN RE-USE
055 ;WE MUST ALLOCATE A FRESH ARRAY
056 OPEN1N: MOVSI A,-1 ;ARRANGE TO GET A FRESH SAR
057 ;WE HAVE A SAR, BUT MUST ALLOCATE A NEW ARRAY BODY
058 OPEN1P: MOVE F,-L.F6BT(FXP) ;GET MODE BITS AGAIN
059 ;DETERMINE SIZE OF NEW ARRAY
060 IFN ITS+D20,[
061 032 013 HLRZ TT,OPEN9A(F) ;FOR ITS AND D20, DESIRABLE SIZES ARE IN A TABLE
062 SKIPGE F .SEE FBT.CM
063 032 013 HRRZ TT,OPEN9A(F)
064 ] ;END OF IFN ITS+D20
065 IFN D10,[
066 ;FOR D10, WE MUST ASK THE OPERATING SYSTEM FOR THE PROPER BUFFER SIZE
067 MOVE TT,-3(FXP) ;GET DEVICE NAME
068 CAME TT,[SIXBIT \TTY\]
069 TRZ F,2 ;? NOT A TTY UNLESS IT IS *THE* TTY
070 TRNN F,2
071 TLZA F,FBT.CM ;ONLY THE TTY CAN BE SINGLE MODE,
072 TLO F,FBT.CM ; AND THE TTY MUST BE SINGLE MODE!
073 SA$ TRNE F,2 ;FOR SAIL, *THE* TTY SHOULD DEFAULT TO LINEMODE
074 SA$ TLO F,FBT.LN
075 MOVEM F,-4(FXP) ;SAVE BACK MODE BITS
076 PUSHN FXP,1 ;PUSH A SLOT FOR BUFFER SIZE DATA
077 023 102 JUMPL F,OPEN1R .SEE FBT.CM
078 IFE SAIL,[
079 033 005 HLRZ T,OPEN9C(F) ;GET DESIRED I/O MODE
080 MOVEI D,T
081 DEVSIZ D, ;ON SUCCESS, GET <NUMBER OF BUFFERS,,BUFFER SIZE>
082 SETO D,
083 SKIPG D
084 MOVE D,[2,,3+LIOBUF] ;ON FAILURE, USE 2 BUFFERS AT LIOBFS WORDS APIECE
085 HLRZ TT,D
086 CAIGE TT,NIOBFS
087 ] ;END IFE SAIL
088 IFN SAIL,[
089 MOVE D,TT ;DEVICE NAME IN D
090 BUFLEN D, ;GET BUFFER SIZE
091 SKIPN D ;NO WAY!! (BUT BETTER CHECK ANYWAY)
092 MOVEI D,LIOBUF+1 ;DEFAULT
093 ADDI D,2 ;WE NEED ACTUAL SIZE OF BUFFER, NOT SIZE-2
094 ] ;END IFN SAIL
095 HRLI D,NIOBFS ;HOWEVER, WE MUST USE AT LEAST NIOBFS BUFFERS
096 MOVEM D,(FXP) ;SAVE THIS DATA
097 HLRZ TT,D
098 IMULI D,(TT) ;GET TOTAL SPACE OCCUPIED BY BUFFERS
099 032 013 HLRZ TT,OPEN9A(F)
100 ADDI TT,(D) ;ADD TO SIZE OF REST OF FILE ARRAY
101 CAIA
102 032 013 OPEN1R: HRRZ TT,OPEN9A(F) ;FOR CHARACTER MODE, TABLE HAS TOTAL ARRAY SIZE
103 ] ;END OF IFN D10
104 PUSHJ P,MKLSAR ;MAKE AN ARRAY - SIZE IN TT, SAR (IF ANY) IN A
105 10$ POP FXP,D
106 OPEN1Q: LOCKI ;LOCK OUT USER INTERRUPTS
OPEN FUNCTION (INCLUDING SAIL EOPEN) QIO[NEW,LSP] 09/18/78 Page 23.2
107
108 ;FALLS THROUGH
OPEN FUNCTION (INCLUDING SAIL EOPEN) QIO[NEW,LSP] 09/18/78 Page 24
001 ;FALLS IN
002
003 ;STATE OF THE WORLD:
004 ; USER INTERRUPTS LOCKED OUT
005 ; SAR FOR FILE ARRAY IN A
006 ; FOR D10, BUFFER SIZE INFORMATION IN D
007 ; P: FIRST ARGUMENT, OR TTY SAR IF ARGUMENT WAS T
008 ; SECOND ARGUMENT
009 ; FIRST ARGUMENT
010 ; (NEGATIVE OF) ACTUAL NUMBER OF ARGS
011 ; FXP: LOCKI WORD
012 ; FILE NAMES IN "SIXBIT" FORMAT (L.F6BT WORDS)
013 ; MODE BITS
014 MOVSI TT,TTS.IM+TTS.BN+TTS.TY+TTS.IO
015 ANDCAM TT,TTSAR(A)
016 MOVE F,-1-L.F6BT(FXP) ;GET MODE BITS
017 032 029 HLLZ TT,OPEN9B(F)
018 IORB TT,TTSAR(A) ;SET CLOSED BIT AND FILE TYPE BITS
019 IFN D10,[
020 024 024 JUMPL F,OPEN1T .SEE FBT.CM
021 HLRZM D,FB.NBF(TT) ;STORE NUMBER OF BUFFERS
022 SUBI D,3
023 HRRZM D,FB.BWS(TT) ;STORE BUFFER DATA SIZE IN WORDS
024 OPEN1T:
025 ] ;END OF IFN D10
026 MOVSI TT,AS.FIL
027 IORB TT,ASAR(A) ;NOW CAN TURN ON FILE ARRAY BIT
028 MOVEI T,-F.GC
029 HRLM T,-1(TT) ;SET UP GC AOBJN POINTER
030 MOVEM A,(P) ;SAVE THE FILE ARRAY SAR
031 002 027 PUSHJ P,ALCHAN ;ALLOCATE A CHANNEL
032 030 003 JRST OPNALZ ;LOSE IF NO FREE CHANNELS
033 MOVE TT,TTSAR(A)
034 HRRZM F,F.CHAN(TT) ;SAVE THE CHANNEL NUMBER IN THE FILE OBJECT
035 POP FXP,T ;BEWARE THE LOCKI WORD!
036 MOVEI D,F.DEV(TT)
037 HRLI D,-L.F6BT+1(FXP)
038 BLT D,F.DEV+L.F6BT-1(TT) ;COPY FILE NAMES INTO FILE OBJECT
039 POPI FXP,L.F6BT ;FLUSH THEM FROM THE STACK
040 EXCH T,(FXP) ;PUT LOCKI WORD ON STACK,
041 PUSH FXP,T ;WITH MODE BITS ABOVE IT
042
043 ;FALLS THROUGH
OPEN FUNCTION (INCLUDING SAIL EOPEN) QIO[NEW,LSP] 09/18/78 Page 25
001 ;FALLS IN
002
003 ;STATE OF THE WORLD:
004 ; USER INTERRUPTS LOCKED OUT
005 ; TTSAR OF FILE ARRAY IN TT
006 ; P: SAR FOR FILE ARRAY
007 ; SECOND ARGUMENT TO OPEN
008 ; FIRST ARGUMENT
009 ; -<# OF ACTUAL ARGS>
010 ; FXP: MODE BITS (THEY OFFICIALLY LIVE HERE, NOT IN T)
011 ; LOCKI WORD
012 ;PDLS MUST STAY THIS WAY FROM NOW ON FOR THE SAKE OF IOJRST'S.
013 030 006 .SEE OPENLZ
014 OPEN3: MOVE T,(FXP) ;GET MODE BITS
015 ;NOW WE ACTUALLY TRY TO OPEN THE FILE
016 IFN ITS,[
017 033 005 MOVE D,OPEN9C(T)
018 TLNE T,FBT.AP ;APPEND MODE =>
019 TRO D,100000 ; ITS WRITE-OVER MODE
020 TLNE T,FBT.EC ;MAYBE OPEN AN OUTPUT TTY
021 TRO D,%TJPP2 ; IN THE ECHO AREA (PIECE OF PAPER #2)
022 031 003 .CALL OPENUP
023 030 022 IOJRST 4,OPNLZ0
024 031 022 .CALL RCHST ;READ BACK THE REAL AND TRUE NAMES
025 .LOSE 1400
026 ] ;END OF IFN ITS
027 IFN D10,[
028 025 121 JUMPL T,OPEN3M .SEE FBT.CM ;NEED NOT ALLOCATE A CHANNEL FOR *THE* TTY
029 MOVE F,F.CHAN(TT)
030 MOVEI D,(F)
031 IMULI D,3
032 ADDI D,BFHD0 ;COMPUTE ADDRESS OF BUFFER HEADER
033 MOVEM D,FB.HED(TT) ;REMEMBER BUFFER HEADER ADR
034 SETZM (D) ;CLEAR BUFFER POINTER (TO FORCE NEW BUFFERS)
035 SETZM 1(D) ;CLEAR OLD BYTE POINTER
036 SETZM 2(D) ;CLEAR BYTE COUNT
037 TRNE T,1
038 MOVSS D ;IF OUTPUT BUFFER, PUT ADDRESS IN LEFT HALF
039 PUSH FXP,TT ;SAVE THE TTSAR
040 033 005 MOVE T,OPEN9C(T) ;GET THE I/O MODE FROM THE TABLE
041 MOVE TT,F.DEV(TT)
042 LSH F,27
043 IOR F,[OPEN 0,T]
044 XCT F ;OPEN THE FILE
045 030 042 JRST OPNAND
046 MOVE R,-1(FXP) ;GET MODE BITS
047 XOR F,[<INBUF>#<OPEN>]
048 TRNE R,1
049 XOR F,[<OUTBUF>#<INBUF>]
050 MOVE TT,(FXP) ;GET BACK TTSAR
051 HRR F,FB.NBF(TT) ;GET NUMBER OF BUFFERS IN RH OF UUO
052 MOVEI TT,FB.BUF(TT)
053 EXCH TT,.JBFF ;.JBFF IS THE ORIGIN FOR ALLOCATING BUFFERS
OPEN FUNCTION (INCLUDING SAIL EOPEN) QIO[NEW,LSP] 09/18/78 Page 25.1
054 XCT F ;TELL THE MONITOR TO ALLOCATE BUFFERS
055 MOVEM TT,.JBFF ;RESTORE OLD VALUE OF .JBFF
056 AND F,[0 17,] ;ISOLATE CHANNEL NUMBER AGAIN
057 IOR F,[LOOKUP 0,T]
058 MOVE TT,(FXP) ;GET TTSAR BACK IN TT
059 TRNE R,1 ;WE NEED TO PERFORM A LOOKUP FOR
060 TLNE R,FBT.AP ; EITHER IN OR APPEND MODE
061 CAIA
062 025 069 JRST OPEN3C
063 MOVE T,F.FN1(TT)
064 MOVE R,F.PPN(TT)
065 HLLZ TT,F.FN2(TT)
066 SETZ D,
067 XCT F ;PERFORM THE LOOKUP
068 030 043 IOJRST 4,OPNLZ1 ;LOSEY LOSEY
069 OPEN3C: MOVE D,-1(FXP) ;GET MODE BITS
070 TRNN D,1 ;NEED TO PERFORM AN ENTER FOR
071 025 083 JRST OPEN3D ; EITHER OUT OR APPEND MODE
072 XOR F,[<ENTER 0,T>#<LOOKUP 0,T>]
073 MOVE TT,(FXP) ;GET TTSAR
074 MOVE T,F.FN1(TT)
075 MOVE R,F.PPN(TT)
076 HLLZ TT,F.FN2(TT)
077 SETZ D,
078 XCT F ;PERFORM THE ENTER
079 030 043 IOJRST 4,OPNLZ1 ;LOSEY LOSEY
080 XOR F,[<OUT 0,>#<ENTER 0,T>]
081 XCT F ;SET UP BUFFER HEADER BYTE POINTER AND COUNT
082 ;AS A RESULT OF THE LOOKUP OR ENTER, THE SIZE INFORMATION IS IN R
083 OPEN3D: MOVE D,TT
084 POP FXP,TT
085 HLLZM D,F.RFN2(TT) ;SAVE AWAY THE REAL, TRUE FILE NAMES
086 MOVEM T,F.RFN1(TT)
087 MOVE D,F.CHAN(TT) ;GET CHANNEL FOR DEVCHR
088 DEVCHR D, ;DEVICE CHRACTERISTICS
089 TLNE D,(DV.DIR) ;IF NON-DIRECTORY ZERO TRUENAMES
090 025 093 JRST OPN3D1
091 SETZM F.RFN2(TT)
092 SETZM F.RFN1(TT)
093 OPN3D1: MOVE D,F.CHAN(TT)
094 SA% DEVNAM D, ;GET REAL NAME OF DEVICE
095 SA$ PNAME D,
096 MOVE D,F.DEV(TT) ;USE GIVEN DEVICE NAME ON FAILURE
097 MOVEM D,F.RDEV(TT)
098 MOVE F,F.CHAN(TT) ;TRY TO DETERMINE REAL PPN
099 SA% DEVPPN F,
100 SA% CAIA
101 025 118 SA% JRST OPEN3F
102 SA% TRZ D,770000
103 CAMN D,[SIXBIT \SYS\]
104 025 113 JRST OPEN3E
105 SA% GETPPN F, ;IF ALL ELSE FAILS, ASSUME YOUR OWN PPN
106 SA% JFCL ;CAN'T REALLY FAIL - THIS JFCL IS FOR ULTRA SAFETY
OPEN FUNCTION (INCLUDING SAIL EOPEN) QIO[NEW,LSP] 09/18/78 Page 25.2
107 SA$ SKIPE F,F.PPN(TT) ;IF PPN WAS SPECIFIED
108 025 118 SA$ JRST OPEN3F ;USE IT AS TRUE PPN
109 SA$ SETZ F,
110 SA$ DSKPPN F, ;FOR SAIL, USE THE DSKPPN (ALIAS)
111 025 118 JRST OPEN3F
112
113 OPEN3E:
114 SA% MOVE F,[%LDSYS]
115 SA% GETTAB R,
116 SA% MOVE F,R70+1 ;ASSUME SYS: IS 1,,1 IF GETTAB FAILS
117 SA$ MOVE F,[SIXBIT \ 1 3\] ;IT'S [1,3] ON SAIL
118 OPEN3F: MOVEM F,F.RPPN(TT)
119 025 123 JRST OPEN3N
120
121 OPEN3M: MOVE D,F.DEV(TT) ;FOR THE TTY, JUST COPY THE DEVICE NAME
122 MOVEM D,F.RDEV(TT)
123 OPEN3N:
124 ] ;END OF IFN D10
125 IFN D20,[
126 MOVE T,F.DEV(TT)
127 CAME T,[ASCII \TTY\] ;SKIP IF OPENING *THE* TTY
128 025 083 JRST OPEN3D
129 MOVEI 1,.PRIIN ;CONSIDER USING THE PRIMARY JFN
130 TLNE TT,TTS.IO ; OF THE APPROPRIATE DIRECTION
131 MOVEI 1,.PRIOU
132 ; GTSTS ;MAKE SURE IT IS OPEN
133 ; JUMPGE 2,OPEN3D .SEE GS%OPN
134 ; MOVSI D,(GS%RDF+GS%NAM) ;MAKE SURE IT CAN DO THE KIND OF I/O WE WANT
135 ; TLNE TT,TTS.IO
136 ; MOVSI D,(GS%WRF+GS%NAM)
137 ; TDC 2,D
138 ; TDCN 2,D
139 MOVE T,(FXP) ;RESTORE FLAG BITS
140 025 113 JRST OPEN3E
141 ;HERE TO ALLOCATE A FRESH JFN AND OPEN THE FILE
142 OPEN3D: PUSH FXP,TT ;SAVE THE TTSAR
143 MOVEI T,F.DEV(TT)
144 HRLI T,-L.F6BT
145 PUSH FXP,(T) ;COPY THE GIVEN DEVICE NAMES ONTO THE STACK
146 AOBJN T,.-1
147 PUSH P,[-1] ;SAY LONG NAMESTRING
148 PUSHJ P,6BTNS ;CONVERT TO A NAMESTRING IN PNBUF
149 POPI P,1
150 POP FXP,TT ;GET TTSAR
151 MOVE T,(FXP) ;RESTORE MODE BITS IN T
152 MOVSI 1,(GJ%ACC+GJ%SHT) .SEE .GJDEF
153 TRNE T,1
154 TLNE T,FBT.AP
155 TLOA 1,(GJ%OLD) ;FOR INPUT OR APPEND, WE WANT AN EXISTING FILE
156 TLO 1,(GJ%FOU+GJ%NEW) ;FOR OUTPUT, A NON-EXISTENT FILE
157 MOVE 2,PNBP
158 GTJFN ;GET A JFN
159 030 022 IOJRST 4,OPNLZ0
OPEN FUNCTION (INCLUDING SAIL EOPEN) QIO[NEW,LSP] 09/18/78 Page 25.3
160 033 005 OPEN3E: MOVE 2,OPEN9C(T) ;GET OPEN MODE
161 TLNE T,FBT.AP ;APPEND MODE, SET APPEND, READ BITS, CLR WRITE
162 TRC 2,OF%APP+OF%WR+OF%RD
163 OPENF ;OPEN THE FILE
164 030 048 IOJRST 4,OPNLZR
165 HRRZM 1,F.JFN(TT) ;SAVE THE JFN IN THE FILE OBJECT
166 ] ;END OF IFN D20
167
168 ;FALLS THROUGH
OPEN FUNCTION (INCLUDING SAIL EOPEN) QIO[NEW,LSP] 09/18/78 Page 26
001 ;FALLS IN
002
003 10$ MOVE T,(FXP) ;FOR D10, FLAGS IN T MIGHT HAVE BEEN DESTROYED
004 026 015 JUMPL T,OPEN3G .SEE FBT.CM
005 032 042 MOVE D,OPEN9D(T) ;SOME INITIALIZATION FOR BLOCK MODE FILES
006 HRRZM D,FB.BYT(TT) ;SET UP BYTE SIZE
007 IFN ITS+D20,[
008 HRRI D,FB.BUF-1(TT)
009 MOVEM D,FB.IBP(TT) ;SET UP INITIAL BUFFER POINTER
010 032 029 HRRZ D,OPEN9B(T)
011 ] ;END OF IFN ITS+D20
012 10$ MOVE D,FB.BWS(TT)
013 IMUL D,FB.BYT(TT) ;SET UP BUFFER LENGTH (IN BYTES)
014 MOVEM D,FB.BFL(TT)
015 OPEN3G: SETZM F.FPOS(TT) ;FILEPOS=0 (UNTIL FURTHER NOTICE)
016
017 ;NOW DETERMINE THE SIZE OF THE FILE, AND SET THE ACCESS POINTER (IF APPLICABLE)
018 ;MODE BITS ARE IN T, TTSAR IS IN TT; FOR D10, FILE SIZE INFO IN R;
019 ;FOR D20, JFN IS IN 1
020
021 IFN ITS,[
022 SKIPL F.FLEN(TT) ;THIS WAS SET BY RCHST BEFORE; -1 = NOT RANDOM
023 026 027 JRST OPEN3P ; ACCESS
024 TLZ T,FBT.AP ;CAN'T APPEND IF NOT RANDOMLY ACCESSIBLE
025 026 116 JRST OPEN3Q
026
027 OPEN3P: HRLZI D,1 ;ASSUME 1000000 FOR FAILING FILLEN (USR DEVICE)
028 031 012 .CALL FILLEN ;DETERMINE LENGTH OF FILE
029 MOVEM D,F.FLEN(TT)
030 TLNN T,FBT.AP
031 026 116 JRST OPEN3Q
032 MOVE D,F.FLEN(TT) ;FOR APPEND MODE, SET THE ACCESS
033 MOVEM D,F.FPOS(TT) ; POINTER TO THE END OF THE FILE
034 031 017 .CALL ACCESS
035 .LOSE 1400
036 ] ;END OF IFN ITS
037 IFN D10,[
038 026 116 JUMPL T,OPEN3Q ;DON'T DO ANY OF THIS FOR TTY
039 SETZM F.FPOS(TT)
040 MOVE D,F.CHAN(TT)
041 DEVCHR D,
042 TLNE D,(DV.DIR)
043 026 049 JRST OPEN3K
044 TLZ T,FBT.AP ;ASSUME A NON-DIRECTORY DEVICE CAN'T APPEND
045 SETOM F.FLEN(TT) ; OR PERFORM RANDOM ACCESS
046 026 116 JRST OPEN3Q
047
048 ;FILE SIZE INFORMATION IS IN R
049 OPEN3K:
050 IFE SAIL,[
051 HLRE R,R ;FOR TOPS-10/CMU, THE LEFT HALF OF R
052 SKIPL R ; IS A WORD COUNT IF NEGATIVE AND A BLOCK COUNT
053 IMULI R,200 ; IF POSITIVE
OPEN FUNCTION (INCLUDING SAIL EOPEN) QIO[NEW,LSP] 09/18/78 Page 26.1
054 MOVMS R
055 ] ;END OF IFE SAIL
056 IFN SAIL,[
057 MOVSS R ;SAIL JUST HAS SWAPPED NAGATIVE WORD COUNT
058 MOVNS R
059 ] ;END OF IFN SAIL
060 IMUL R,FB.BYT(TT)
061 MOVEM R,F.FLEN(TT) ;STORE FILE LENGTH
062 TLNN T,FBT.AP
063 026 116 JRST OPEN3Q
064 MOVEM R,F.FPOS(TT) ;FOR APPEND MODE, SET POINTER TO EOF
065 MOVE F,F.CHAN(TT)
066 LSH F,27
067 SA% IOR F,[USETI 0,-1]
068 SA$ IOR F,[UGETF 0,R] ;THIS UUO WILL CLOBBER R
069 XCT F ;SET MONITOR'S POINTER TO EOF
070 IFN SAIL,[
071 ;HACK UP ON SAIL'S RECORD OFFSET FEATURE
072 SETZM FB.ROF(TT) ;ASSUME NO RECORD OFFSET
073 TLNN D,200000 ;SKIP IF DSK/UDP (DEVCHR RESULT IS STILL IN D)
074 026 116 JRST OPEN3Q
075 MOVEM T,(FXP)
076 PUSH FXP,TT
077 XOR F,[<MTAPE 0,T>#<UGETF 0,R>]
078 MOVE T,[SIXBIT \GODMOD\]
079 MOVEI TT,20 ;SIXBIT \GODMOD\ ? 20 => GET RECORD OFFSET IN D
080 XCT F
081 POP FXP,TT
082 MOVE T,(FXP) ;CONVERT RECORD OFFSET TO A BYTE OFFSET
083 SUBI D,1 ; FROM THE LOGICAL ORIGIN OF THE FILE
084 IMUL D,FB.BFL(TT)
085 MOVNM D,FB.ROF(TT) ;STORE AS A NEGATIVE OFFSET IN BYTES
086 ] ;END OF IFN SAIL
087 ] ;END OF IFN D10
088 IFN D20,[
089 TLNN T,FBT.AP
090 026 111 JRST OPEN3L
091 SETO 2,
092 SFPTR ;SET FILE POSITION TO END FOR APPENDING
093 026 100 JRST OPEN3J
094 RFPTR ;READ BACK THE ACTUAL POSITION
095 030 006 IOJRST 4,OPENLZ
096 MOVEM 2,F.FLEN(TT)
097 MOVEM 2,F.FPOS(TT)
098 026 116 JRST OPEN3Q
099
100 OPEN3J: CAIE 1,SFPTX2 ;ILLEGAL TO RESET POINTER FOR THIS FILE?
101 030 006 IOJRST 4,OPENLZ
102 TLZ T,FBT.AP ;IF SO, JUST SAY WE CAN'T APPEND
103 SETOM F.FLEN(TT)
104 026 116 JRST OPEN3Q
105
106 OPN3LA: CAIE 1,DESX4 ;SIZEF LEGAL FOR THIS DEVICE?
OPEN FUNCTION (INCLUDING SAIL EOPEN) QIO[NEW,LSP] 09/18/78 Page 26.2
107 030 006 IOJRST 4,OPENLZ ;NOPE, MUST BE SOME REAL ERROR
108 SETO 2, ;ELSE -1 IS LENGTH OF FILE
109 026 113 JRST OPN3LB
110
111 OPEN3L: SIZEF ;GET SIZE OF FILE
112 026 106 JRST OPN3LA
113 OPN3LB: MOVEM 2,F.FLEN(TT) ;SAVE AS LENGTH OF FILE
114 SETZM F.FPOS(TT) ;SET FILE POSITION TO ZERO
115 ] ;END OF IFN D20
116 OPEN3Q: MOVEM T,(FXP) ;SAVE BACK POSSIBLY ALTERED MODE BITS
117 IFN ITS,[
118 TLNN T,FBT.CA ;FOR THE CLA DEVICE,
119 026 126 JRST OPEN3H ; GOBBLE DOWN THE FIRST TWO WORDS,
120 MOVEI T,F.RFN1(TT) ; WHICH ARE THE SIXBIT FOR THE
121 HRLI T,444400 ; UNAME-JNAME OF THE SENDER, AND
122 MOVEI D,2 ; USE THEM FOR THE TRUENAMES
123 017 095 .CALL SIOT ; OF THE FILE ARRAY
124 030 006 IOJRST 4,OPENLZ
125 MOVE T,(FXP) ;RESTORE MODE BITS
126 OPEN3H:
127 ] ;END OF IFN ITS
128 TRNE T,1
129 026 136 JRST OPEN3V
130 HRRZ D,DEOFFN ;FOR INPUT, GET THE DEFAULT EOFFN
131 MOVEM D,FI.EOF(TT)
132 SETZM FI.BBC(TT)
133 ; SETZM FI.BBF(TT) ;NOT IMPLEMENTED YET
134 026 145 JRST @OPEN3Z(T) ;DISPATCH TO APPROPRIATE PLACE
135
136 OPEN3V: HRRZ D,DENDPAGEFN ;FOR OUTPUT, GET THE DEFAULT ENDPAGEFN
137 MOVEM D,FO.EOP(TT)
138 MOVE D,DPAGEL ;DEFAULT PAGEL
139 MOVEM D,FO.PGL(TT)
140 MOVE D,DLINEL ;DEFAULT LINEL
141 MOVEM D,FO.LNL(TT)
142 SETZM FB.BVC(TT)
143 026 145 JRST @OPEN3Z(T) ;DISPATCH TO APPROPRIATE PLACE
144
145 027 007 OPEN3Z: OPNAI1 ;ASCII DSK INPUT
146 027 002 OPNAO1 ;ASCII DSK OUTPUT
147 027 023 OPNTI1 ;ASCII TTY INPUT
148 028 001 OPNTO1 ;ASCII TTY OUTPUT
149 027 006 OPNBI1 ;FIXNUM DSK INPUT
150 027 001 OPNBO1 ;FIXNUM DSK OUTPUT
151 027 023 OPNTI1 ;FIXNUM TTY INPUT
152 028 001 OPNTO1 ;FIXNUM TTY OUTPUT
153 027 007 OPNAI1 ;IMAGE DSK INPUT
154 027 002 OPNAO1 ;IMAGE DSK OUTPUT
155 027 023 OPNTI1 ;IMAGE TTY INPUT
156 028 001 OPNTO1 ;IMAGE TTY OUTPUT
OPEN FUNCTION (INCLUDING SAIL EOPEN) QIO[NEW,LSP] 09/18/78 Page 27
001 OPNBO1:
002 029 032 OPNAO1: JUMPL T,OPNAT3 .SEE FBT.CM
003 MOVE D,FB.BFL(TT)
004 MOVEM D,FB.BVC(TT)
005 027 008 JRST OPNA6
006 OPNBI1:
007 OPNAI1: SETZM FB.BVC(TT)
008 OPNA6:
009 IFN ITS+D20,[
010 029 032 JUMPL T,OPNAT3 .SEE FBT.CM
011 MOVE D,FB.IBP(TT) ;INITIALIZE BUFFER BYTE POINTER
012 032 029 HRRZ R,OPEN9B(T)
013 TRNN T,1
014 ADDI D,(R) ;FOR AN INPUT BUFFER, FB.BP MUST BE ADJUSTED;
015 MOVEM D,FB.BP(TT) ; THE FIRST "EMPTY" BUFFER ISN'T A REAL ONE
016 MOVE D,FB.BFL(TT)
017 TRNN T,1
018 SETZ D,
019 MOVEM D,FB.CNT(TT)
020 ] ;END OF IFN ITS+D20
021 029 032 JRST OPNAT3
022
023 OPNTI1:
024 027 007 10$ JUMPGE T,OPNAI1 .SEE FBT.CM ;ONLY *THE* TTY HAS THESE HACKS
025 SETZM TI.BFN(TT)
026 SETZM FT.CNS(TT)
027 IFN ITS,[
028 MOVE D,[STTYW1]
029 MOVEM D,TI.ST1(TT)
030 MOVE D,[STTYW2]
031 MOVEM D,TI.ST2(TT)
032 029 002 .CALL TTYGET
033 030 006 IOJRST 4,OPENLZ
034 ;TURN OFF AUTO-INT, SUPER-IMAGE
035 TLZ F,%TSINT+%TSSII
036 TRNE T,10 ;TTY IMAGE INPUT =>
037 TLO F,%TSSII ; ITS SUPER-IMAGE INPUT
038 029 009 .CALL TTYSET
039 030 006 IOJRST 4,OPENLZ
040 ] ;END OF IFN ITS
041 IFN SAIL,[
042 MOVEI D,[SACTW1 ? SACTW2 ? SACTW3 ? SACTW4]
043 HRLI D,TI.ST1(T)
044 SETACT D
045 MOVSS D
046 BLT D,TI.ST4(T)
047 SETO D,
048 GETLIN D
049 AOSN D ;IF NOT -1 THEN OK TO USE CHARACTERISTICS
050 SETZ D, ; ELSE CAN MAKE NO ASSUMPTIONS ABOUT TTY
051 TLNE D,460000 ;CHECK DISLIN, DMLIN, DDDLIN
052 TLOA T,FBT.FU
053 TLZ T,FBT.FU
OPEN FUNCTION (INCLUDING SAIL EOPEN) QIO[NEW,LSP] 09/18/78 Page 27.1
054 MOVEM T,(FXP)
055 ] ;END OF IFN SAIL
056 IFN D20,[
057 MOVE 2,[CCOC1]
058 MOVEM 2,TI.ST1(TT)
059 MOVE 3,[CCOC2]
060 MOVEM 3,TI.ST2(TT)
061 MOVE 1,F.JFN(TT)
062 SFCOC ;SET CCOC WORDS
063 MOVEI 2,TT%WKF+TT%WKN+TT%WKP+TT%ECO+<.TTASC←6> .SEE TT%DAM
064 TRNE T,10
065 027 063 XORI 2,<.TTBIN#.TTASC>←6 .SEE TT%DAM
066 SFMOD
067 ] ;END OF IFN D20
068 029 032 JRST OPNAT3
OPEN FUNCTION (INCLUDING SAIL EOPEN) QIO[NEW,LSP] 09/18/78 Page 28
001 OPNTO1:
002 027 002 10$ JUMPGE T,OPNAO1 .SEE FBT.CM ;ONLT *THE* TTY HAS THESE HACKS!
003 SETZM FT.CNS(TT)
004 IFN ITS,[
005 029 021 .CALL CNSGET ;SET FO.RPL, FO.LNL, AND GET TTYOPT IN D
006 030 006 IOJRST 4,OPENLZ
007 MOVSI R,200000 ;INFINITE PAGEL INITIALLY
008 MOVEM R,FO.PGL(TT)
009 SOS FO.LNL(TT)
010 TLZ T,FBT.SA+FBT.CP+FBT.SE
011 TLNE D,%TOSA1 ;SKIP UNLESS WE HAVE SAIL CHARS
012 TLO T,FBT.SA ;SET SAIL BIT
013 TLNE D,%TOMVU ;IF WE CAN MOVE BACK, ASSUME WE
014 TLO T,FBT.CP ; ARE A DISPLAY TERMINAL (THIS IS OK ACCORDING
015 ; TO ITSTTY)
016 TLNE D,%TOERS ;REMEMBER THE SELECTIVE ERASE BIT
017 TLO T,FBT.SE .SEE RUB1CH
018 MOVEM T,(FXP)
019 TLNN T,FBT.EC
020 028 023 JRST OPNTO5
021 029 016 .CALL SCML ;FOR ECHO AREA, SET NUMBER OF ECHO LINES TO 5
022 .LOSE 1400
023 029 002 OPNTO5: .CALL TTYGET
024 .LOSE 1400
025 TLNE F,%TSROL ;TURN ON SCROLL MODE IF TTY DEFAULTLY SCROLLS
026 TLO T,FBT.SC
027 MOVEM T,(FXP)
028 TLZ F,%TSFCO
029 TLNE T,FBT.FU
030 TLO F,%TSFCO
031 TLNE T,FBT.SC ;IF SCROLL MODE SET SCROLLING
032 TLO F,%TSROL
033 .CALL TTYSAC
034 .LOSE 1400
035 045 015 PUSHJ FXP,CLRO4 ;INITIALIZE LINENUM AND CHARPOS
036 027 008 JRST OPNA6
037 ] ;END OF IFN ITS
038 IFN D10,[
039 MOVSI D,200000 ;INFINITY (???)
040 EXCH D,FO.PGL(TT)
041 MOVEM D,FO.RPL(TT)
042 SETZM AT.CHS(TT) ;SIGH
043 SETZM AT.LNN(TT)
044 IFE SAIL,[
045 SETO R,
046 GETLIN R, ;GET OUR TTY LINE NUMBER
047 TLZ R,-1
048 MOVEI D,.TOWID
049 MOVE F,[-2,,D]
050 TRMOP. F, ;TRY DETERMINING WIDTH OF TERMINAL
051 MOVEI D,111
052 SUBI D,1
053 MOVEM D,FO.LNL(TT)
OPEN FUNCTION (INCLUDING SAIL EOPEN) QIO[NEW,LSP] 09/18/78 Page 28.1
054 027 008 JRST OPNA6
055 ] ;END OF IFE SAIL
056 ;IFN SAIL, FALLS THROUGH TO OPNAT3
057 ] ;END OF IFN D10
058 IFN D20,[
059 MOVE 1,F.JFN(TT)
060 RFMOD ;READ JFN MODE WORD FOR TERMINAL
061 LDB D,[.BP TT%WID,1]
062 SUBI D,1
063 MOVEM D,[FO.LNL(TT)] ;SET LINEL
064 LDB D,[.BP TT%LEN,1]
065 MOVEM D,FO.RPL(TT)
066 TRNN 1,TT%PGM
067 MOVSI D,200000 ;FOR NON-PAGED MODE, USE INFINITY
068 MOVEM D,FO.PGL(TT)
069 045 015 PUSHJ FXP,CLRO4 ;INITIALIZE LINENUM AND CHARPOS
070 027 008 JRST OPNA6
071 ] ;END OF IFN D20
OPEN FUNCTION (INCLUDING SAIL EOPEN) QIO[NEW,LSP] 09/18/78 Page 29
001 IFN ITS,[
002 TTYGET: SETZ
003 029 002 SIXBIT \TTYGET\ ;GET TTYST1, TTYST2, TTYSTS
004 ,,F.CHAN(TT) ;TTY CHANNEL #
005 2000,,D ;TTYST1
006 2000,,R ;TTYST2
007 402000,,F ;TTYSTS
008
009 TTYSET: SETZ
010 029 009 SIXBIT \TTYSET\ ;SET TTYST1, TTYST2, TTYSTS
011 ,,F.CHAN(TT) ;TTY CHANNEL #
012 ,,TI.ST1(TT) ;TTYST1
013 ,,TI.ST2(TT) ;TTYST2
014 400000,,F ;TTYSTS
015
016 SCML: SETZ
017 029 016 SIXBIT \SCML\ ;SET NUMBER OF COMMAND LINES
018 ,,F.CHAN(TT) ;TTY CHANNEL #
019 401000,,5 ;NUMBER OF LINES
020
021 CNSGET: SETZ
022 029 021 SIXBIT \CNSGET\ ;GET CONSOLE PARAMETERS
023 ,,F.CHAN(TT) ;TTY CHANNEL #
024 2000,,FO.RPL(TT) ;VERTICAL SCREEN SIZE
025 2000,,FO.LNL(TT) ;HORIZONTAL SCREEN SIZE
026 2000,,D ;TCTYP (THROW AWAY)
027 2000,,D ;TTYCOM (THROW AWAY)
028 402000,,D ;TTYOPT
029 ;TTYTYP NOT GOTTEN
030 ] ;END OF IFN ITS
031
032 OPNAT3: TRNE T,2
033 029 036 JRST OPNAT5
034 SETZM AT.CHS(TT)
035 SETZM AT.LNN(TT)
036 OPNAT5: MOVEI D,1
037 MOVEM D,AT.PGN(TT)
038 OPEN4: POP FXP,F.MODE(TT)
039 POP P,A ;SAR FOR FILE ARRAY - RETURNED
040 MOVEI TT,-1
041 SETZM @TTSAR(A) ;ILLEGAL FOR LOSER TO ACCESS AS ARRAY
042 MOVSI TT,TTS<CL>
043 ANDCAM TT,TTSAR(A) ;UNCLOSE IT
044 POPI P,3 ;FLUSH 2 ARGS AND # OF ARGS
045 20$ SETZB 2,3 ;MAKE SURE AC'S CONTAIN NO JUNK
046 UNLKPOPJ ;WE HAVE WON!
OPEN FUNCTION (INCLUDING SAIL EOPEN) QIO[NEW,LSP] 09/18/78 Page 30
001 ;;; VARIOUS ERROR HANDLERS - ARRIVE WITH A MESSAGE IN C.
002
003 OPNALZ: MOVEI C,[SIXBIT \ALL I/O CHANNELS ALREADY IN USE!\]
004 POP FXP,-L.F6BT-1(FXP) ;FAKE OUT CORRECT PDL CONDITIONS
005 POPI FXP,L.F6BT-1
006 OPENLZ: MOVE F,F.CHAN(TT) ;REMEMBER, C HAS ERROR MSG
007 SETZM CHNTB(F) ;CLOSE CHANNEL AND DEALLOCATE
008 IFN ITS,[
009 002 058 .CALL ALCHN9
010 .LOSE 1400
011 ] ;END OF IFN ITS
012 IFN D10,[
013 LSH F,27
014 IOR F,[RELEASE 0,0]
015 XCT F
016 ] ;END OF IFN D10
017 IFN D20,[
018 HRRZ 1,F.JFN(TT)
019 CLOSF
020 HALT
021 ] ;END OF IFN D20
022 OPNLZ0: POP P,AR1 ;FILE OBJECT SAR
023 POP P,A ;SECOND ARG
024 POP P,B ;FIRST ARG
025 POP P,T ;ARG COUNT
026 030 031 JUMPN T,OPNLZ3
027 MOVEI A,(AR1)
028 007 009 PUSHJ P,NAMELIST
029 030 036 JRST OPNLZ2
030
031 OPNLZ3: PUSHJ P,ACONS
032 EXCH A,B
033 PUSHJ P,ACONS
034 CAMN T,XC-2
035 HRRM B,(A)
036 OPNLZ2: MOVEI B,Q$OPEN
037 POPI FXP,1
038 UNLOCKI
039 014 166 JRST XCIOL
040
041 IFN D10,[
042 014 169 OPNAND: MOVEI C,NSDERR ;NO SUCH DEVICE
043 OPNLZ1: POPI FXP,1
044 030 022 JRST OPNLZ0
045 ] ;END OF IFN D10
046
047 IFN D20,[
048 OPNLZR: RLJFN
049 HALT
050 030 022 JRST OPNLZ0
051 ] ;END OF IFN D20
OPEN FUNCTION (INCLUDING SAIL EOPEN) QIO[NEW,LSP] 09/18/78 Page 31
001 IFN ITS,[
002
003 OPENUP: SETZ
004 SIXBIT \OPEN\ ;OPEN FILE
005 5000,,(D) ;I/O MODE BITS
006 ,,F.CHAN(TT) ;CHANNEL #
007 ,,F.DEV(TT) ;DEVICE NAME
008 ,,F.FN1(TT) ;FILE NAME 1
009 ,,F.FN2(TT) ;FILE NAME 2
010 400000,,F.SNM(TT) ;SNAME
011
012 FILLEN: SETZ
013 031 012 SIXBIT \FILLEN\ ;GET FILE LENGTH (IN WORDS)
014 ,,F.CHAN(TT) ;CHANNEL #
015 402000,,F.FLEN(TT) ;PUT RESULT IN F.FLEN OF THE FILE OBJECT
016
017 ACCESS: SETZ
018 031 017 SIXBIT \ACCESS\ ;SET FILE ACCESS POINTER
019 ,,F.CHAN(TT) ;CHANNEL #
020 400000,,F.FPOS(TT) ;POSITION
021
022 RCHST: SETZ
023 031 022 SIXBIT \RCHST\ ;READ CHANNEL STATUS
024 ,,F.CHAN(TT) ;CHANNEL #
025 2000,,F.RDEV(TT) ;DEVICE NAME
026 2000,,F.RFN1(TT) ;FILE NAME 1
027 2000,,F.RFN2(TT) ;FILE NAME 2
028 2000,,F.RSNM(TT) ;SNAME
029 402000,,F.FLEN(TT) ;ACCESS POINTER
030 ] ;END OF IFN ITS
OPEN FUNCTION (INCLUDING SAIL EOPEN) QIO[NEW,LSP] 09/18/78 Page 32
001 ;;; TABLES FOR OPEN FUNCTION
002
003 ;;; ALL TABLES ARE INDEXED BY THE RIGHT HALF OF THE MODE WORD.
004
005 IT$ RBFSIZ==:200 ;RANDOM BUFFER SIZE
006 20$ RBFSIZ==:200
007 10$ RBFSIZ==:0
008
009 ;;; SIZES FOR FILE ARRAYS: <BLOCKMODE SIZE>,,<CHARMODE SIZE>
010 ;;; FOR D10, THIS IS THE SIZE EXCLUSIVE OF THE BUFFER; FOR ITS AND D20, INCLUSIVE.
011 ;;; SIZES ARE IN WORDS.
012
013 032 005 OPEN9A: FB.BUF+RBFSIZ,,FB.BUF ;ASCII DSK INPUT
014 032 005 FB.BUF+RBFSIZ,,FB.BUF ;ASCII DSK OUTPUT
015 ,,FB.BUF+NASCII/2 ;ASCII TTY INPUT
016 032 005 FB.BUF+RBFSIZ,,FB.BUF ;ASCII TTY OUTPUT
017 032 005 FB.BUF+RBFSIZ,,FB.BUF ;FIXNUM DSK INPUT
018 032 005 FB.BUF+RBFSIZ,,FB.BUF ;FIXNUM DSK OUTPUT
019 ,,FB.BUF+NASCII/2 ;FIXNUM TTY INPUT
020 032 005 FB.BUF+RBFSIZ,,FB.BUF ;FIXNUM TTY OUTPUT
021 032 005 FB.BUF+RBFSIZ,,FB.BUF ;IMAGE DSK INPUT
022 032 005 FB.BUF+RBFSIZ,,FB.BUF ;IMAGE DSK OUTPUT
023 ,,FB.BUF+NASCII/2 ;IMAGE TTY INPUT
024 032 005 FB.BUF+RBFSIZ,,FB.BUF ;IMAGE TTY OUTPUT
025
026 ;;; <BITS FOR LEFT HALF OF TTSAR>,,<BLOCK MODE BUFFER SIZE>
027 ;;; THE RIGHT HALF IS NOT REALLY USED FOR D10.
028
029 OPEN9B:
030 IRP X,,[A,X,I]J,,[,+BN,+IM] ;ASCII/FIXNUM/IMAGE
031 IRP Y,,[D,T]K,,[,+TY] ;DSK/TTY
032 IRP Z,,[I,O]L,,[,+IO] ;IN/OUT
033 IFSE X!!Y!!Z,IDI, LDGTW5: .SEE LDGTWD ;CROCK
034 032 005 TTS<CL!J!!K!!L>,,RBFSIZ
035 TERMIN
036 TERMIN
037 TERMIN
038
039 ;;; <LEFT HALF FOR FB.IBP>,,<BYTES PER WORD>
040 ;;; RELEVANT ONLY FOR BLOCK MODE FILES. ONLY THE RIGHT HALF IS USED FOR D10.
041
042 OPEN9D: 010700,,5 ;ASCII DSK INPUT
043 010700,,5 ;ASCII DSK OUTPUT
044 0 ;ASCII TTY INPUT (IRRELEVANT)
045 010700,,5 ;ASCII TTY OUTPUT
046 004400,,1 ;FIXNUM DSK INPUT
047 004400,,1 ;FIXNUM DSK OUTPUT
048 0 ;FIXNUM TTY INPUT (IRRELEVANT)
049 IT$ 001400,,3 ;FIXNUM TTY OUTPUT
050 10$ SA% 010700,,5
051 10$ SA$ 001100,,4
052 20$ 010700,,5
053 010700,,5 ;IMAGE DSK INPUT
OPEN FUNCTION (INCLUDING SAIL EOPEN) QIO[NEW,LSP] 09/18/78 Page 32.1
054 010700,,5 ;IMAGE DSK OUTPUT
055 0 ;IMAGE TTY INPUT (IRRELEVANT)
056 10% 041000,,4 ;IMAGE TTY OUTPUT
057 10$ SA% 010700,,5
058 10$ SA$ 001100,,4 ? WARN [IMAGE TTY OUTPUT?]
OPEN FUNCTION (INCLUDING SAIL EOPEN) QIO[NEW,LSP] 09/18/78 Page 33
001 ;;; OPEN9C CONTAINS THE OPEN MODE WORD. FOR D10, THE MODE IS ALWAYS
002 ;;; BLOCK MODE IF THIS TABLE IS USED. FOR D20, THERE IS NO DIFFERENCE
003 ;;; IN THIS TABLE FOR BLOCK VERSUS SINGLE MODE.
004
005 OPEN9C:
006 IFN ITS,[
007 ;;; RECALL THE MEANINGS OF THE FOLLOWING BITS IN ITS:
008 ;;; 1.3 0 => ASCII, 1 => IMAGE
009 ;;; 1.2 0 => UNIT (CHARACTER) MODE, 1 => BLOCK MODE
010 ;;; 1.1 0 => INPUT, 1 => OUTPUT
011 ;;; ITS BLOCK MODE IS NOT USED FOR BUFFERED FILES; RATHER, SIOT IS USED.
012 0 ;ASCII DSK INPUT
013 1 ;ASCII DSK OUTPUT
014 0 ;ASCII TTY INPUT
015 %TJDIS+1 ;ASCII TTY OUTPUT (DISPLAY IF POSSIBLE)
016 4 ;FIXNUM DSK INPUT
017 5 ;FIXNUM DSK OUTPUT
018 %TIFUL+0 ;FIXNUM TTY INPUT (>7 BITS ON IMLACS AND TVS)
019 %TJDIS+1 ;FIXNUM TTY OUTPUT
020 0 ;IMAGE DSK INPUT
021 1 ;IMAGE DSK OUTPUT
022 0 ;IMAGE TTY INPUT (SUPER-IMAGE INPUT)
023 %TJSIO+1 ;IMAGE TTY OUTPUT (SUPER-IMAGE OUTPUT)
024 ] ;END OF IFN ITS
025 IFN D10,[
026 .IOASC ;ASCII DSK INPUT
027 .IOASC ;ASCII DSK OUTPUT
028 .IOASC ;ASCII TTY INPUT
029 .IOASC ;ASCII TTY OUTPUT
030 .IOBIN ;FIXNUM DSK INPUT
031 .IOBIN ;FIXNUM DSK OUTPUT
032 .IOASC ;FIXNUM TTY INPUT
033 .IOASC ;FIXNUM TTY OUTPUT
034 .IOASC ;IMAGE DSK INPUT
035 .IOASC ;IMAGE DSK OUTPUT
036 .IOIMG ;IMAGE TTY INPUT
037 .IOIMG ;IMAGE TTY OUTPUT
038 ] ;END OF IFN D10
039 IFN D20,[
040 .SEE OF%BSZ OF%MOD
041 070000,,OF%RD ;ASCII DSK INPUT
042 070000,,OF%WR ;ASCII DSK OUTPUT
043 070000,,OF%RD ;ASCII TTY INPUT
044 070000,,OF%WR ;ASCII TTY OUTPUT
045 440000,,OF%RD ;FIXNUM DSK INPUT
046 440000,,OF%WR ;FIXNUM DSK OUTPUT
047 070000,,OF%RD ;FIXNUM TTY INPUT
048 070000,,OF%WR ;FIXNUM TTY OUTPUT
049 070000,,OF%RD ;IMAGE DSK INPUT
050 070000,,OF%WR ;IMAGE DSK OUTPUT
051 100000,,OF%RD ;IMAGE TTY INPUT
052 100000,,OF%WR ;IMAGE TTY OUTPUT
053 ] ;END OF IFN D20
OPEN FUNCTION (INCLUDING SAIL EOPEN) QIO[NEW,LSP] 09/18/78 Page 33.1
054
055 IFN SAIL,[
056 ;EOPEN FOR SAIL -- HANDLE 'E' FILES
057
058 ;;; DO AN OPEN, THEN, IF THE FILE IS OPEN IN NON-IMAGE NON-TTY ASCII MODE SKIP
059 ;;; OVER E'S COMMENT BY DOING SUCCESIVE IN'S
060 $EOPEN: MOVEI TT,(P) ;MUST CALCULATE WHERE RETURN ADR IS
061 ADD TT,T ;SUBTRACT NUMBER OF ARGS GIVEN
062 PUSH FXP,(TT) ;REMEMBER USER'S RETURN ADR
063 033 066 MOVEI R,$EOPN1 ;NEW RETURN ADR
064 MOVEM R,(TT)
065 021 002 JRST $OPEN ;NOW OPEN THE FILE
066 $EOPN1: MOVEI TT,F.MODE ;GET MODE OF FILE
067 HRRZ TT,@TTSAR(A)
068 SKIPE TT ;ASCII, DSK, INPUT?
069 POPJ FXP, ;NOPE, JUST RETURN
070 PUSH P,A ;REMEMBER FILE ARRAY
071 PUSH FXP,[440700,,[ASCIZ \COMMENT ⊗\]]
072 $EOPN2: ILDB T,(FXP) ;GET NEXT CHARACTER TO LOOK FOR
073 033 092 JUMPE T,$EOPN5 ;LOOKS LIKE WE FOUND AN 'E' FILE, SKIP INDEX
074 033 078 PUSH P,[$EOPN3] ;RETURN ADR
075 PUSH P,-1(P) ;THE FILE ARRAY TO READ FROM
076 MOVNI T,1 ;ONE ARG
077 JRST %TYI+1 ;TYI ONE CHARACTER FROM THE FILE (NCALL)
078 033 110 $EOPN3: JUMPL TT,$EOPN4 ;EOF -- ERROR!
079 LDB T,(FXP) ;GET THE CURRENT CHARACTER
080 CAIN T,(TT) ;MATCH?
081 033 072 JRST $EOPN2 ;YES, KEEP SCANNING THE FILE
082 033 087 PUSH P,[$EOPN6] ;NOPE, FILEPOS TO BOF
083 PUSH P,-1(P) ;FILE ARRAY
084 PUSH P,CIN0 ;ZERO - LOGICAL BOF
085 MOVNI T,2 ;TWO ARGS -- SET FILEPOS
086 039 011 JRST FILEPOS
087 $EOPN6: POPI FXP,1 ;BYTE POINTER
088 POP P,A ;FILE ARRAY RETURNED IN A
089 POPJ FXP, ;RETURN TO USER
090
091 ;HERE WHEN FOUND AN 'E' FILE, SKIP TO AFTER ↑L AFTER NEXT ↑V
092 033 096 $EOPN5: PUSH P,[$EOPN7] ;RETURN ADR
093 PUSH P,-1(P) ;THE FILE ARRAY TO READ FROM
094 MOVNI T,1 ;ONE ARG
095 JRST %TYI+1 ;TYI ONE CHARACTER FROM THE FILE (NCALL)
096 033 110 $EOPN7: JUMPL TT,$EOPN4 ;EOF -- ERROR!
097 CAIE TT,↑V ;FOUND ↑V?
098 033 092 JRST $EOPN5 ;NOPE, KEEP ON LOOPING
099 033 103 $EOPN8: PUSH P,[$EOPN9] ;RETURN ADR
100 PUSH P,-1(P) ;THE FILE ARRAY TO READ FROM
101 MOVNI T,1 ;ONE ARG
102 JRST %TYI+1 ;TYI ONE CHARACTER FROM THE FILE (NCALL)
103 033 110 $EOPN9: JUMPL TT,$EOPN4 ;EOF -- ERROR!
104 CAIE TT,↑L ;FOUND ↑L?
105 033 099 JRST $EOPN8 ;NOPE, KEEP ON LOOPING
106 POPI FXP,1 ;GET RID OF BYTE POINTER
OPEN FUNCTION (INCLUDING SAIL EOPEN) QIO[NEW,LSP] 09/18/78 Page 33.2
107 POP P,A ;RETURN FILE ARRAY
108 POPJ FXP, ;TO USER
109
110 $EOPN4: POP P,A ;FILE ARRAY -- EOF, WE LOST
111 FAC [EOF READING A FILE WHICH LOOKED LIKE AN 'E' FILE - EOPEN!]
112 ] ;END IFN SAIL
DEFAULTF, ENDPAGEFN, EOFFN QIO[NEW,LSP] 09/18/78 Page 34
001 SUBTTL DEFAULTF, ENDPAGEFN, EOFFN
002
003 ;;; (DEFAULTF X) SETS THE DEFAULT NAMELIST TO X.
004 ;;; X IS MERGEF'D WITH THE OLD NAMELIST FIRST.
005 ;;; IT FOLLOWS THAT (DEFAULTF NIL) = (NAMELIST NIL).
006
007 DEFAULTF:
008 011 018 PUSHJ P,FIL6BT
009 012 028 PUSHJ P,DMRGF
010 PUSHJ P,6BTNML
011 MOVEM A,VDEFAULTF
012 POPJ P,
013
014 034 007 SSCRFILE==DEFAULTF
015
016 ;;; (EOFFN F) GETS INPUT FILE F'S END-OF-FILE FUNCTION.
017 ;;; (EOFFN F X) SETS THE FUNCTION TO BE X.
018 ;;; (ENDPAGEFN F) GETS OUTPUT FILE F'S END-OF-PAGE FUNCTION.
019 ;;; (ENDPAGEFN F X) SETS IT TO BE X.
020
021 ENDPAGEFN:
022 JSP TT,LWNACK ;LSUBR (1 . 2)
023 LA12,,QENDPAGEFN
024 005 018 MOVEI TT,ATOFOK
025 MOVEI B,DENDPAGEFN
026 MOVEI C,QENDPAGEFN
027 034 034 JRST EOFFN0
028
029 EOFFN: JSP TT,LWNACK ;LSUBR (1 . 2)
030 LA12,,QEOFFN
031 005 010 MOVEI TT,IFILOK
032 MOVEI B,DEOFFN
033 MOVEI C,QEOFFN
034 034 057 EOFFN0: AOJN T,EOFFN5
035 POP P,AR1
036 034 054 JUMPE AR1,EOFFN2
037 IFN SFA,[
038 PUSH FXP,TT
039 004 007 JSP TT,XFOSP ;SFA?
040 034 047 JRST EOFFNZ
041 034 047 JRST EOFFNZ ;NOPE
042 POPI FXP,1
043 MOVEI A,(AR1) ;CALL THE SFA, AND RETURN ITS ANSWER
044 HRRZI B,(C) ;THE OPERATION -- EOFFN OR ENDPAGEFUN
045 SETZ C, ;WE WANT THE SFA TO RETURN A VALUE
046 047 133 JRST ISTCSH ;SHORT INTERNAL CALL
047 EOFFNZ: POP FXP,TT
048 ] ;END IFN SFA
049 PUSHJ P,(TT)
050 MOVEI TT,FI.EOF .SEE FO.EOP
051 HRRZ A,@TTSAR(AR1)
052 UNLKPOPJ
053
DEFAULTF, ENDPAGEFN, EOFFN QIO[NEW,LSP] 09/18/78 Page 34.1
054 EOFFN2: HRRZ A,(B)
055 POPJ P,
056
057 EOFFN5: POP P,A
058 POP P,AR1
059 034 078 JUMPE AR1,EOFFN7
060 IFN SFA,[
061 PUSH FXP,TT
062 004 007 JSP TT,XFOSP ;CHECK IF WE HAVE AN SFA
063 034 071 JRST EOFFNY
064 034 071 JRST EOFFNY ;NOPE
065 POPI FXP,1
066 JSP T,%NCONS ;LISTIFY IT SO IT IS IDENTIFIABLE AS AN ARG
067 MOVEI B,(C) ;THE OPERATION
068 MOVEI C,(A) ;AS THE ARG TO THE SFA
069 MOVEI A,(AR1) ;THE SFA ITSELF
070 047 133 JRST ISTCSH ;DO THE SHORT INTERNAL CALL
071 EOFFNY: POP FXP,TT ;UNDO PUSHES
072 ] ;END IFN SFA
073 PUSHJ P,(TT)
074 MOVE TT,TTSAR(AR1)
075 HRRZM A,FI.EOF(TT) .SEE FO.EOP
076 UNLKPOPJ
077
078 EOFFN7: HRRZM A,(B)
079 POPJ P,
LISTEN FUNCTION QIO[NEW,LSP] 09/18/78 Page 35
001 SUBTTL LISTEN FUNCTION
002
003 ;;; (LISTEN X) LISTENS TO THE SPECIFIED TTY X.
004
005 $LISTEN:
006 SKIPA F,CFIX1 ;LSUBR (0 . 1) NCALLABLE
007 MOVEI F,CPOPJ
008 HRRZ AR1,V%TYI
009 035 013 JUMPE T,$LSTN3
010 MOVEI D,Q$LISTEN
011 AOJN T,S1WNAL
012 POP P,AR1 ;FILE ARRAY SPECIFIED
013 $LSTN3:
014 IFN SFA,[
015 004 007 JSP TT,XFOSP ;FILE OR SFA?
016 035 025 JRST $LSTNS
017 035 025 JRST $LSTNS ;NOT AN SFA
018 011 046 JSP T,QIOSAV
019 MOVEI A,(AR1) ;SFA IN A
020 MOVEI B,Q$LISTEN ;OPERATION
021 SETZ C, ;NO THIRD ARG
022 047 133 PUSHJ P,ISTCSH ;SHORT INTERNAL SFA INVOCATION
023 MOVE TT,(A) ;BE PREPARED IF NCALL'ED
024 POPJ P,
025 $LSTNS: ] ;END IFN SFA
026 005 030 PUSHJ P,TIFLOK ;IT BETTER BE TTY INPUT
027 IFN ITS,[
028 035 068 .CALL LISTEN ;SO LISTEN ALREADY
029 SETZ R, ;ON FAILURE, JUST ASSUME 0
030 ] ;END OF IFN ITS
031 IFN D10,[
032 SKIPL T,F.MODE(TT) .SEE FBT.CM
033 035 044 SA$ JRST $LSTN4 ? WARN [REALLY OUGHT TO BE SMARTER]
034 035 049 SA% JRST $LSTN5
035 IFE SAIL,[
036 TLNE T,FBT.LN
037 SKIPA D,[SKPINL]
038 MOVSI D,(SKPINC)
039 ] ;END OF IFE SAIL
040 IFN SAIL,[
041 MOVE D,[SNEAKS R,]
042 035 048 JRST $LSTN6
043
044 $LSTN4: MOVE D,F.CHAN(TT)
045 LSH D,27
046 IOR D,[TTYSKP 0,]
047 ] ;END OF IFN SAIL
048 $LSTN6: XCT D
049 $LSTN5: TDZA R,R
050 MOVEI R,1
051 ] ;END OF IFN D10
052 IFN D20,[
053 HRRZ 1,F.JFN(TT)
LISTEN FUNCTION QIO[NEW,LSP] 09/18/78 Page 35.1
054 SIBE ;SKIP IF INPUT BUFFER EMPTY
055 SKIPA R,2 ;NUMBER OF WAITING CHARS IN 2
056 SETZ R,
057 ] ;END OF IFN D20
058 MOVEI TT,FI.BBC
059 MOVE A,@TTSAR(AR1) ;ALSO COUNT IN ANY BUFFERED
060 TLZE A,-1 ; UP CHARACTERS PENDING
061 AOS R
062 JSP T,LNG1A
063 ADD TT,R
064 UNLOCKI
065 JRST (F)
066
067 IFN ITS,[
068 LISTEN: SETZ
069 035 068 SIXBIT \LISTEN\ ;LISTEN AT A TTY, ALREADY
070 ,,F.CHAN(TT) ;TTY CHANNEL #
071 402000,,R ;NUMBER OF TYPED-AHEAD CHARS
072 ] ;END OF IFN ITS
LINEL, PAGEL, CHARPOS, LINENUM, PAGENUM QIO[NEW,LSP] 09/18/78 Page 36
001 SUBTTL LINEL, PAGEL, CHARPOS, LINENUM, PAGENUM
002
003 ;;; VARIOUS FUNCTIONS TO GET AND SET A FILE'S LINEL, PAGEL,
004 ;;; CHARPOS, LINENUM, AND PAGENUM.
005
006 LINEL: SKIPA D,CFIX1
007 MOVEI D,CPOPJ
008 036 046 JSP F,FLFROB ;LSUBR (1 . 2)
009 FO.LNL,,QLINEL
010 005 018 DLINEL,,ATOFOK
011
012 PAGEL: SKIPA D,CFIX1
013 MOVEI D,CPOPJ
014 036 046 JSP F,FLFROB ;LSUBR (1 . 2)
015 FO.PGL,,QPAGEL
016 005 018 DPAGEL,,ATOFOK
017
018 CHARPOS:
019 SKIPA D,CFIX1
020 MOVEI D,CPOPJ
021 036 046 JSP F,FLFROB ;LSUBR (1 . 2)
022 AT.CHS,,QCHARPOS
023 005 018 0,,ATOFOK
024
025 LINENUM:
026 SKIPA D,CFIX1
027 MOVEI D,CPOPJ
028 036 046 JSP F,FLFROB ;LSUBR (1 . 2)
029 AT.LNN,,QLINEN
030 005 014 0,,ATFLOK
031
032 PAGENUM:
033 SKIPA D,CFIX1
034 MOVEI D,CPOPJ
035 036 046 JSP F,FLFROB ;LSUBR (1 . 2)
036 AT.PGN,,QPAGENUM
037 005 014 0,,ATFLOK
038
039 IFN SFA,[
040 FLFWNA: HRRZ D,(F) ;FUNCTION NAME
041 JRST WNALOSE ;WNA ERROR
042
043 FLNSFL: EXCH AR1,A
044 WTA [NOT SFA OR FILE!]
045 ] ;END IFN SFA
046 FLFROB:
047 IFN SFA,[
048 CAME T,XC-1 ;WRONG NUMBER OF ARGS?
049 CAMN T,XC-2
050 SKIPA
051 036 040 JRST FLFWNA
052 MOVEI TT,(P) ;TOP OF STACK CONTAINS FILE ARG?
053 CAMN T,XC-2 ;UNLESS TWO ARGS
LINEL, PAGEL, CHARPOS, LINENUM, PAGENUM QIO[NEW,LSP] 09/18/78 Page 36.1
054 MOVEI TT,-1(P)
055 MOVE A,(TT) ;GET THE ARG
056 CAIN A,TRUTH
057 MOVE A,V%TYO
058 MOVEM A,(TT) ;RE-STORE IT INCASE IT HAS BEEN ALTERED
059 036 081 JUMPE A,FLFRF1 ;IF NIL THEN HANDLE SPECIALLY
060 EXCH A,AR1
061 004 007 JSP TT,XFOSP
062 036 043 JRST FLNSFL ;NOT AN SFA OR FILE
063 036 080 JRST FLFRFL
064 AOSE T ;HAVE TWO ARGS?
065 POP P,AR1 ;YES, IT WILL BECOME SECOND ARG TO SFA
066 EXCH AR2A,(P) ;SAVE AR2A ON STACK, GET SFA
067 PUSH P,A ;SAVE OLD AR1
068 PUSH P,C
069 PUSH P,B
070 MOVEI A,(AR2A) ;SFA INTO A
071 HRRZ B,(F) ;OPERATION NAME INTO B
072 MOVEI C,(AR1) ;THIRD ARG
073 047 133 PUSHJ P,ISTCSH
074 POP P,B
075 POP P,C
076 POP P,AR1
077 POP P,AR2A
078 JSP T,FXNV1 ;MAKE SURE RESULT IS A FIXNUM
079 POPJ P,
080 FLFRFL: EXCH A,AR1
081 FLFRF1: ] ;END IFN SFA
082 036 100 AOJN T,FLFRB5
083 PUSH P,AR1
084 MOVE AR1,-1(P)
085 MOVEM D,-1(P)
086 036 095 JUMPE AR1,FLFRB3
087 FLFRB1: HRRZ TT,1(F)
088 PUSHJ P,(TT)
089 HLRZ TT,(F)
090 MOVM TT,@TTSAR(AR1) .SEE STERPRI ;LINEL MAY BE NEGATIVE
091 UNLOCKI
092 FLFB1A: POP P,AR1
093 POPJ P,
094
095 FLFRB3: HLRZ TT,1(F)
096 036 087 JUMPE TT,FLFRB1
097 MOVE TT,(TT)
098 036 092 JRST FLFB1A
099
100 FLFRB5: POP P,A
101 JSP T,FXNV1
102 PUSH P,AR1
103 MOVE AR1,-1(P)
104 MOVEM D,-1(P)
105 MOVE D,TT
106 036 118 JUMPE AR1,FLFRB7
LINEL, PAGEL, CHARPOS, LINENUM, PAGENUM QIO[NEW,LSP] 09/18/78 Page 36.2
107 FLFRB6: HRRZ TT,1(F)
108 PUSHJ P,(TT)
109 HLRZ TT,(F)
110 MOVMS D
111 EXCH D,@TTSAR(AR1)
112 SKIPGE D
113 MOVNS @TTSAR(AR1)
114 UNLOCKI
115 FLFRB8: MOVE TT,D
116 036 092 JRST FLFB1A
117
118 FLFRB7: HLRZ TT,1(F)
119 036 107 JUMPE TT,FLFRB6
120 MOVMM D,(TT)
121 036 115 JRST FLFRB8
IN QIO[NEW,LSP] 09/18/78 Page 37
001 SUBTTL IN
002
003 ;;; (IN X) INPUTS ONE FIXNUM FROM THE BINARY FILE X AND
004 ;;; RETURNS IT.
005
006 $IN: PUSH P,CFIX1 ;SUBR 1 - NCALLABLE - ACS 1
007 PUSH P,AR1
008 IFN SFA,[
009 004 005 JSP TT,AFOSP ;FILE OR SFA OR NOT?
010 JFCL ;NOT, LET OTHER CODE GIVE ERROR
011 037 023 JRST $INNOS ;NOT SFA, PROCEED
012 POP P,AR1
013 PUSHJ FXP,SAV5M1 ;SAVE ALL BUT A
014 MOVEI B,Q$IN ;IN OPERATION
015 SETZ C, ;NO THIRD ARG
016 047 133 PUSHJ P,ISTCSH ;SHORT +INTERNAL-SFA-CALL
017 PUSHJ P,RST5M1
018 MOVE T,CFIX1
019 CAMN T,(P) ;NCALL'ED?
020 POPI P,1 ;YUP, WILL RETURN ARGS IN BOTH A AND TT
021 JSP T,FXNV1 ;INSURE A FIXNUM
022 POPJ P, ;RETURN
023 $INNOS: ] ;END IFN SFA
024 MOVEI AR1,(A)
025 005 038 PUSHJ P,XIFLOK ;LOCKI
026 IFN ITS+D20,[
027 MOVEI R,(TT) ;SAVE A COPY OF TTSAR
028 SKIPL F.MODE(TT) .SEE FBT.CM
029 037 060 JRST $IN2
030 ;FOR ITS AND D20, HANDLE SINGLE MODE FILES
031 IFN ITS,[
032 PUSH FXP,[%TIACT] ;ASSUME A TTY
033 TLNN TT,TTS.TY ;A TTY?
034 SETZM (FXP) ;NO, SO NO FLAG BITS
035 MOVE T,[444400,,TT] ;READ ONE 36.-BIT BYTE INTO TT
036 MOVEI D,1
037 037 136 .CALL INSIOT
038 .LOSE 1400
039 POPI FXP,1
040 037 121 JUMPN D,$IN7 ;IF WE GOT NO WORD, ASSUME EOF
041 ] ;END OF IFN ITS
042 IFN D20,[
043 PUSH P,B ;PRESERVE AC'S
044 PUSH P,C
045 HRRZ 1,F.JFN(TT)
046 MOVE 2,[444400,,TT] ;READ ONE 36.-BIT BYTE INTO TT
047 MOVNI 3,1
048 SIN ;"STRING" INPUT
049 POP P,C
050 POP P,B
051 037 121 JUMPN D,$IN7 ;NO BYTE MEANS EOF
052 ] ;END OF IFN D20
053 AOS F.FPOS(R)
IN QIO[NEW,LSP] 09/18/78 Page 37.1
054 037 067 JRST $IN1
055 ] ;END OF IFN ITS+D20
056 IFN D10,[
057 SKIPGE F.MODE(TT) .SEE FBT.CM
058 HALT ;SINGLE MODE BINARY FILE IS ILLEGAL
059 ] ;END OF IFN D10
060 $IN2:
061 10$ HRRZ D,FB.HED(TT)
062 10% SOSGE FB.CNT(TT) ;ARE THERE ANY BYTES LEFT?
063 10$ SOSGE 2(D)
064 037 071 JRST $IN3 ;NO, GO GET ANOTHER BUFFER FULL
065 10% ILDB TT,FB.BP(TT) ;YES, GOBBLE DOWN THE NEXT BYTE
066 10$ ILDB TT,1(D)
067 $IN1: POP P,AR1
068 UNLKPOPJ
069
070 ;GET THE NEXT INPUT BUFFER
071 $IN3:
072 IFN ITS,[
073 MOVE T,FB.IBP(TT)
074 MOVEM T,FB.BP(TT) ;REINITIALIZE BYTE POINTER
075 MOVE D,FB.BVC(TT)
076 ADDM D,F.FPOS(TT) ;UPDATE FILE POSITION
077 MOVE D,FB.BFL(TT) ;GET BUFFER LENGTH INTO D
078 MOVE R,D ;GET NEXT BUFFER-LOAD
079 017 095 .CALL SIOT
080 .LOSE 1400
081 SUB R,D ;GET COUNT OF BYTES OBTAINED
082 MOVEM R,FB.CNT(TT)
083 MOVEM R,FB.BVC(TT)
084 037 060 JUMPN R,$IN2 ;EXIT IF WE GOT ANY (ELSE EOF)
085 ] ;END OF IFN ITS
086 IFN D10,[
087 HRRZ F,F.CHAN(TT)
088 LSH F,27
089 IOR F,[IN 0,]
090 XCT F ;GET NEXT INPUT BUFFER
091 037 095 JRST $IN4 ;SUCCESS
092 XOR F,[<STATO 0,IO.EOF>#<IN 0,>]
093 XCT F ;SKIP IF EOF
094 HALT ;ERROR IF NOT EOF?
095 $IN4: MOVE F,2(D) ;GET, FROM HEADER, NUMBER OF BYTES READ
096 MOVEM F,FB.BVC(TT) ;STORE IN BUFFER VALID COUNT
097 037 060 JUMPG F,$IN2 ;IF READ ANYTHING THEN USE IT
098 ] ;END OF IFN D10
099 IFN D20,[
100 PUSH P,B
101 PUSH P,C
102 HRRZ 1,F.JFN(TT)
103 MOVE 2,FB.IBP(TT)
104 MOVEM 2,FB.BP(TT)
105 MOVN 3,FB.BFL(TT)
106 SIN ;"STRING" INPUT
IN QIO[NEW,LSP] 09/18/78 Page 37.2
107 MOVE D,FB.BVC(TT)
108 ADDM D,F.FPOS(TT)
109 ADD D,3
110 MOVEM D,FB.CNT(TT) ;ACTUAL COUNT OF BYTES OBTAINED
111 MOVEM D,FB.BVC(TT)
112 POP P,C
113 POP P,B
114 037 060 JUMPN D,$IN2 ;JUMP IF WE GOT AT LEAST ONE BYTE
115 PUSH P,B
116 GTSTS ;GET FILE STATUS
117 TLNN 2,(GS%EOF) ;SKIP ON EOF
118 HALT ;HALT FOR OTHER LOSS
119 POP P,B
120 ] ;END OF IFN D20
121 $IN7: MOVEI A,(AR1) ;NO DATA WORDS - EOF
122 HRRZ T,FI.EOF(TT)
123 UNLOCKI
124 POP P,AR1
125 037 128 JUMPE T,$IN8
126 JCALLF 1,(T) ;CALL USER EOF FUNCTION
127
128 $IN8: PUSH P,B ;NO USER EOF FUNCTION
129 PUSHJ P,NCONS
130 MOVEI B,Q$IN
131 PUSHJ P,XCONS
132 POP P,B
133 IOL [EOF - IN!] ;SIGNAL ERROR
134
135 IFN ITS,[
136 INSIOT: SETZ
137 017 095 SIXBIT \SIOT\ ;STRING I/O TRANSFER
138 ,,F.CHAN(TT) ;CHANNEL #
139 ,,T ;BYTE POINTER
140 ,,D ;BYTE COUNT
141 404000,,(FXP)
142 ] ;END IFN ITS
143
OUT QIO[NEW,LSP] 09/18/78 Page 38
001 SUBTTL OUT
002
003 ;;; (OUT X N) OUTPUTS THE FIXNUM N TO THE FILE X. RETURNS T.
004
005 $OUT: PUSH P,AR1 ;SUBR 2 - ACS 1
006 IFN SFA,[
007 004 005 JSP TT,AFOSP ;FILE OR SFA OR NOT?
008 JFCL ;NOT, LET OTHER CODE GIVE ERROR
009 038 015 JRST $OUTNS ;NOT SFA, PROCEED
010 POP P,AR1
011 011 046 JSP T,QIOSAV
012 MOVEI C,(B) ;ARG IS FIXNUM TO OUTPUT
013 MOVEI B,Q$OUT ;OUT OPERATION
014 047 133 JRST ISTCSH ;SHORT +INTERNAL-SFA-CALL
015 $OUTNS: ] ;END IFN SFA
016 JSP T,FXNV2
017 MOVEI AR1,(A)
018 005 042 PUSHJ P,XOFLOK
019 SKIPL F.MODE(TT) .SEE FBT.CM
020 038 049 JRST $OUT2
021 ;OUTPUT ONE BYTE TO A SINGLE MODE BINARY FILE
022 10$ HALT ;SINGLE MODE BINARY FILE ILLEGAL FOR D10
023 IFN ITS,[
024 MOVE R,D
025 MOVEI D,1
026 MOVE T,[444400,,R]
027 017 095 .CALL SIOT
028 .LOSE 1400
029 ] ;END OF IFN ITS
030 IFN D20,[
031 PUSH P,B
032 PUSH P,C
033 HRRZ 1,F.JFN(TT)
034 MOVE 2,[444400,,D]
035 MOVNI 3,1
036 SOUT
037 POP P,C
038 POP P,B
039 ] ;END OF IFN D20
040 IFN ITS+D20,[
041 AOS F.FPOS(TT)
042 038 056 JRST $OUT1
043 ] ;END OF IFN ITS+D20
044
045 $OUT3: PUSH FXP,D
046 10% SETZM FB.CNT(TT) ;DOING OWN BUFFERED I/O, -1 IN FB.CNT IS N.G.
047 017 045 PUSHJ P,IFORCE ;FORCE OUT CURRENT OUTPUT BUFFER
048 POP FXP,D
049 $OUT2:
050 10$ HRRZ R,FB.HED(TT)
051 10% SOSGE FB.CNT(TT) ;SEE IF THERE IS ROOM FOR ANOTHER BYTE
052 10$ SOSGE 2(R)
053 038 045 JRST $OUT3 ;NO, GO OUTPUT THIS BUFFER FIRST
OUT QIO[NEW,LSP] 09/18/78 Page 38.1
054 10% IDPB D,FB.BP(TT) ;STICK BYTE IN BUFFER
055 10$ IDPB D,1(R)
056 $OUT1: POP P,AR1
057 JRST UNLKTRUE
FILEPOS, LENGTHF QIO[NEW,LSP] 09/18/78 Page 39
001 SUBTTL FILEPOS, LENGTHF
002
003 ;;; FILEPOS FUNCTION
004 ;;; (FILEPOS F) RETURNS CURRENT FILE POSITION
005 ;;; (FILEPOS F N) SETQ FILEPOS TO X
006 ;;; FOR ASCII FILES, THE POSITION IS MEASURED IN CHARACTERS;
007 ;;; FOR FIXNUM FILES, IN FIXNUMS (WORDS). ZERO IS THE
008 ;;; BEGINNING OF THE FILE. ERROR IF FILE IS NOT RANDOMLY
009 ;;; ACCESSIBLE.
010
011 FILEPOS:
012 039 037 AOJE T,FPOS1 ;ONE ARG => GET
013 040 002 AOJE T,FPOS5 ;TWO ARGS => SET
014 MOVEI D,QFILEPOS ;ARGH! ARGH! ARGH! ...
015 JRST S2WNALOSE
016
017 IFN D20,[
018 FPOS0E: POP P,B
019 039 024 JRST FPOS0D
020 ] ;END OF IFN D20
021
022 039 028 FPOS0B: SKIPA C,FPOS0
023 031 017 FPOS0C: MOVEI C,[SIXBIT \ILLEGAL ACCESS POINTER!\]
024 FPOS0D: MOVEI A,(B) ;COME HERE FOR TWO-ARG CASE,
025 PUSHJ P,NCONS ; MESSAGE IN C
026 039 030 JRST FPOS0A
027
028 031 017 FPOS0: MOVEI C,[SIXBIT \FILE NOT RANDOMLY ACCESSIBLE!\]
029 SETZ A, ;HERE FOR ONE-ARG ERROR, MESSAGE IN C
030 FPOS0A: MOVEI B,(AR1)
031 PUSHJ P,XCONS
032 MOVEI B,QFILEPOS
033 UNLOCKI
034 014 166 JRST XCIOL
035
036 ;ONE-ARGUMENT CASE: GET FILE POSITION
037 FPOS1: POP P,AR1 ;ARG IS FILE
038 IFN SFA,[
039 004 007 JSP TT,XFOSP ;DO WE HAVE AN SFA?
040 039 046 JRST FP1SF1 ;NOPE
041 039 046 JRST FP1SF1 ;NOPE
042 MOVEI A,(AR1) ;YES, CALL THE STREAM
043 MOVEI B,QFILEPOS
044 SETZ C, ;NO ARGS
045 047 133 JRST ISTCSH
046 FP1SF1: ] ;END IFN SFA
047 005 046 PUSHJ P,FILOK ;DOES LOCKI
048 SKIPGE F.FLEN(TT)
049 039 028 JRST FPOS0 ;ERROR IF NOT RANDOMLY ACCESSIBLE
050 SKIPGE D,F.FPOS(TT)
051 039 056 JRST FPOS1A
052 10$ MOVE R,FB.HED(TT)
053 ADD D,FB.BVC(TT)
FILEPOS, LENGTHF QIO[NEW,LSP] 09/18/78 Page 39.1
054 10% SUB D,FB.CNT(TT) ;FOR BUFFERED FILES, ADJUST FOR COUNT
055 10$ SUB D,2(R)
056 FPOS1A: TLNN TT,TTS<IO>
057 SKIPN B,FI.BBC(TT)
058 039 066 JRST FPOS2
059 TLZE B,-1 ;ALLOW FOR ANY BUFFERED BACK CHARS
060 SUBI D,1
061 039 066 FPOS1C: JUMPE B,FPOS2
062 HRRZ B,(B)
063 SA% SKIPLE D
064 SA$ CAMLE D,FB.ROF(TT) ;FOR SAIL, MAY BE AS LOW AS RECORD OFFSET
065 039 061 SOJA D,FPOS1C
066 FPOS2: MOVE TT,D ;RETURN POSITION AS FIXNUM
067 UNLOCKI
068 JRST FIX1
FILEPOS, LENGTHF QIO[NEW,LSP] 09/18/78 Page 40
001 ;TWO-ARGUMENT CASE: SET FILE POSITION
002 FPOS5: POP P,B ;SECOND ARG IS T, NIL, OR FIXNUM
003 POP P,AR1 ;FIRST IS FILE
004 IFN SFA,[
005 004 007 JSP TT,XFOSP ;DO WE HAVE AN SFA?
006 040 014 JRST FP5SF1 ;NOPE, CONTINUE
007 040 014 JRST FP5SF1 ;NOPE
008 MOVEI A,(B) ;LISTIFY THE ARG
009 JSP T,%NCONS
010 MOVEI C,(A) ;PASS IT AS THE ARG TO THE SFA
011 MOVEI A,(AR1) ;THE SFA
012 MOVEI B,QFILEPOS ;FILEPOS OPERATION
013 047 133 JRST ISTCSH
014 FP5SF1: ] ;END IFN SFA
015 SETZ D,
016 040 019 JUMPE B,FPOS5A ;NIL MEANS ABSOLUTE BEGINNING OF FILE
017 CAIE B,TRUTH ;T MEANS END OF FILE
018 JSP T,FXNV2 ;OTHERWISE A FIXNUM POSITION
019 005 046 FPOS5A: PUSHJ P,FILOK ;DOES LOCKI, SAVES D
020 10$ TLNN TT,TTS.IO ;OUTPUT LOSES FOR D10
021 SKIPGE F.FLEN(TT) ;NOT RANDOMLY ACCESSIBLE?
022 039 023 JRST FPOS0C
023 039 023 SA% JUMPL D,FPOS0C ;FOR NON-SAIL, NEGATIVE POSITION ILLEGAL
024 SA$ CAMGE D,FB.ROF(TT) ;FOR SAIL, MAY BE DOWN TO RECORD OFFSET
025 039 023 SA$ JRST FPOS0C
026 IFN ITS+D20,[
027 TLNN TT,TTS.IO
028 040 039 JRST FPOS6
029 PUSH FXP,D
030 017 045 PUSHJ P,IFORCE ;FORCE OUTPUT BUFFER
031 POP FXP,D
032 MOVE R,F.FPOS(TT) ;CALCULATE PRESENT FILE POSITION
033 SKIPL F.MODE(TT)
034 ADD R,FB.BVC(TT)
035 SKIPL F.MODE(TT)
036 SUB R,FB.CNT(TT)
037 CAMLE R,F.FLEN(TT) ;ADJUST LENGTH UPWARD IF NECESSARY
038 MOVEM R,F.FLEN(TT)
039 FPOS6:
040 ] ;END OF IFN ITS+D20
041 CAMLE D,F.FLEN(TT)
042 039 023 JRST FPOS0C ;LOSE IF SPECIFIED POSITION GREATER THAN LENGTH
043 SA$ CAIN B,NIL ;R IS BY DEFAULT 0, BUT FOR SAIL
044 SA$ MOVE D,FB.ROF(TT) ; NIL MEANS USE THE RECORD OFFSET
045 CAIN B,TRUTH
046 MOVE D,F.FLEN(TT)
047 IFE D10,[
048 TLNE TT,TTS.IO ;DETERMINE IF BYTE WE DESIRE IS IN THE BUFFER
049 040 070 JRST FPOSZ ; IF AN INPUT FILE
050 MOVE R,F.FPOS(TT) ;POSITION OF FIRST BYTE IN BUFFER
051 CAMGE D,R ;IF TARGET TOO SMALL THEN MUST DO I/O
052 040 070 JRST FPOSZ
053 ADD R,FB.BVC(TT) ;ADD IN NUMBER OF BYTES IN THE BUFFER
FILEPOS, LENGTHF QIO[NEW,LSP] 09/18/78 Page 40.1
054 CAML D,R ;IF TARGET TOO LARGE THEN ALSO MUST DO I/O
055 040 070 JRST FPOSZ
056 MOVE R,F.FPOS(TT) ;IN RANGE, GET POS OF FIRST BYTE IN BUFFER
057 SUBM D,R ;MAKE R INTO BYTE OFFSET INTO BUFFER
058 MOVE D,FB.IBP(TT) ;RESTORE BYTE POINTER
059 MOVEM D,FB.BP(TT)
060 MOVE D,FB.BVC(TT) ;GET VALID NUMBER OF BYTES IN BUFFER
061 SUBI D,(R) ;NUMBER OF BYTES REMAINING
062 MOVEM D,FB.CNT(TT) ; IS THE NEW COUNT
063 KAKI SKIPE R
064 KAKI IBP FB.BP(TT) ;SKIP APPROPRIATE NUMBER OF BYTES
065 KAKI SOJG R,.-1
066 KL ADJBP R,FB.BP(TT)
067 KL MOVEM R,FB.BP(TT)
068 SETZM FI.BBC(TT) ;CLEAR BUFFERED BACK CHARACTER
069 JRST UNLKTRUE
070 FPOSZ:
071 ] ;END IFE D10
072
073 MOVEM D,F.FPOS(TT)
074 IFN ITS,[
075 031 017 .CALL ACCESS ;SET FILE POSITION
076 039 024 IOJRST 0,FPOS0D ;JUMP ON FAILURE
077 ] ;END OF IFN ITS
078 IFN D20,[
079 PUSH P,B
080 CAME D,F.FLEN(TT) ;BE ULTRA CAUTIOUS
081 SKIPA 2,D
082 SETO 2,
083 HRRZ 1,F.JFN(TT)
084 SFPTR ;SET FILE POINTER
085 039 018 IOJRST 0,FPOS0E
086 POP P,B
087 ] ;END OF IFN D20
088 IFN D10,[
089 IDIV D,FB.BFL(TT) ;DIVIDE FILE POSITION BY BUFFER LENGTH
090 MOVE T,F.CHAN(TT)
091 LSH T,27
092 TLO T,(USETI 0,0)
093 HRRI T,1(D) ;BLOCKS ARE NUMBERED 1-ORIGIN
094 XCT T ;POSITION FILE TO CORRECT BLOCK
095 IMUL D,FB.BFL(TT) ;CALCUALTE F.FPOS
096 MOVEM D,F.FPOS(TT)
097 MOVE T,FB.HED(TT)
098 SETZM 2(T) ;ZERO THE REMAINING BYTE COUNT
099 HRLZI D,400000 ;NOW WE HAVE TO ZERO ALL USE BITS
100 FPOS6C: HRRZ T,(T) ;GET POINTER TO NEXT BUFFER
101 SKIPL (T) ;THIS ONE IN USE?
102 040 105 JRST FPOS6B ;NOPE, SO WE ARE DONE
103 XORM D,(T) ;CLEAR THE USE BIT
104 040 100 JRST FPOS6C ;AND LOOP OVER ALL BUFFERS
105 FPOS6B:
106 ] ;END OF IFN D10
FILEPOS, LENGTHF QIO[NEW,LSP] 09/18/78 Page 40.2
107 10% TLNE TT,TTS.IO
108 040 112 10% JRST FPOS6A
109 SETZM FB.BVC(TT)
110 SETZM FI.BBC(TT)
111 ; SETZM FI.BBF(TT) ;NOT IMPLEMENTED YET
112 FPOS6A:
113 IFN ITS+D20,[
114 SKIPGE F.MODE(TT)
115 JRST UNLKTRUE ;THAT'S ALL FOR SINGLE MODE FILES
116 TLNE TT,TTS.IO
117 040 143 JRST FPOS7 ;JUMP FOR OUTPUT FILES
118 ] ;END OF IFN ITS+D20
119 MOVE T,TT
120 10$ PUSH FXP,R ;R HAS DESIRED BYTE WITHIN BLOCK
121 PUSHJ P,$DEV5K ;GET NEW INPUT BUFFER
122 JFCL ;IGNORE EOF
123 10% JRST UNLKTRUE
124 IFN D10,[
125 POP FXP,R
126 MOVE TT,FB.HED(T)
127 MOVN D,R
128 ADDM D,2(TT) ;DECREASE COUNT BY NUMBER OF SKIPPED BYTES
129 KAKI SKIPE R
130 KAKI IBP 1(TT) ;SKIP APPROPRIATE NUMBER OF BYTES
131 KAKI SOJG R,.-1
132 KL ;DUE TO TOPS-10 LOSSAGE, ADJBP WILL LEAVE BYTE POINTER ALIGNED INCORRECTLY.
133 KL ; THEREFORE, TO GUARUNTEE CORRECT BIT ALIGNMENT, 1 IBP MUST BE DONE BY HAND
134 KL JUMPLE R,UNLKTRUE
135 KL IBP 1(TT)
136 KL SOJLE R,UNLKTRUE
137 KL ADJBP R,1(TT)
138 KL MOVEM R,1(TT)
139 ] ;END OF IFN D10
140 JRST UNLKTRUE
141
142 IFN ITS+D20,[
143 017 082 FPOS7: JSP D,FORCE6 ;INITIALIZE OUTPUT POINTERS
144 JRST UNLKTRUE
145 ] ;END OF IFN ITS+D20
146
147
148 ;;; LENGTHF -- SUBR, 1 ARG, NCALLABLE
149 ;;; RETURNS THE LENGTH OF AN OPEN FILE
150 $LENWT: EXCH A,AR1
151 SFA% WTA [NOT A FILE - LENGTHF!]
152 SFA$ WTA [NOT A FILE OR SFA - LENGTHF!]
153 $LENGTHF:
154 PUSH P,CFIX1 ;STANDARD ENTRY, RETURN FIXNUM
155 ;ALTERNATE ENTRY, RETURN NUMBER IN TT
156 EXCH A,AR1 ;FILE/SFA INTO AR1
157 004 007 JSP TT,XFOSP ;MUST BE EITHER
158 040 150 JRST $LENWT
159 IFN SFA,[
FILEPOS, LENGTHF QIO[NEW,LSP] 09/18/78 Page 40.3
160 040 171 JRST $LENFL
161 EXCH AR1,A
162 011 046 JSP T,QIOSAV
163 MOVEI B,Q$LENGTHF
164 SETZ C,
165 047 133 PUSHJ P,ISTCSH ;SHORT INTERNAL SFA CALL
166 MOVE T,CFIX1
167 CAMN T,(P) ;WE WILL RETURN RESULTS IN A AND TT, SO NO NEED TO RECONS
168 POPI P,1
169 JSP T,FXNV1
170 POPJ P,
171 $LENFL: ] ;END IFN SFA
172 EXCH A,AR1
173 MOVEI TT,F.FLEN ;GET FILE LENGTH
174 MOVE TT,@TTSAR(A)
175 POPJ P, ;RETURNS TO CFIX1 OR CPOPJ
CONTROL-P CODES AND TTY INITIALIZATION QIO[NEW,LSP] 09/18/78 Page 41
001 SUBTTL CONTROL-P CODES AND TTY INITIALIZATION
002
003 IFN ITS,[
004
005 ;;; PUSH A ↑P CODE INTO A TTY FILE ARRAY IN AR1.
006 ;;; THE CHARACTER TO FOLLOW THE ↑P IS IN D.
007 ;;; IF THE CHARACTER IS "H, "I, OR "V, THEN THE SECOND
008 ;;; CHARACTER IS IN THE LEFT HALF OF D.
009 ;;; CHARPOS, LINENUM, AND PAGEL ARE CORRECTLY UPDATED.
010 ;;; I/O LOSSES DUE TO INTERRUPTS BETWEEN ↑P AND THE
011 ;;; NEXT CHARACTER ARE SCRUPULOUSLY AVOIDED.
012 ;;; CLOBBERS T, TT, D, AND F. SAVES R (SEE RUB1C3).
013
014 CNPCOD: .5LKTOPOPJ .SEE INTTYR
015 .SEE CRSRP7
016 HLLOS NOQUIT
017 MOVE T,TTSAR(AR1)
018 041 076 .CALL VAROPT ;GET TTYOPT INTO TT
019 JRST CZECHI ;OH WELL, ASSUME NOTHING IS LEGAL
020 041 083 XCT CNPOK-"A(D) ;IS THIS FUNCTION DOABLE?
021 JRST CZECHI ;WOULD HAVE NO AFFECT ANYWAY SO JUST RETURN
022 CNPCUR: MOVE TT,F.MODE(T)
023 PUSH FXP,D
024 041 031 JUMPL TT,CNPCD1 .SEE FBT.CM
025 MOVE TT,FB.CNT(T)
026 SUBI TT,3
027 041 031 JUMPGE TT,CNPCD1
028 MOVE TT,T ;IF THERE ISN'T ROOM IN THE CURRENT BUFFER
029 017 045 PUSHJ P,IFORCE ; FOR THE WHOLE ↑P CODE SEQUENCE, FORCE
030 MOVE T,TTSAR(AR1) ; OUT THE BUFFER TO AVOID TIMING ERRORS
031 CNPCD1: SETZM ATO.LC(T) ;IF USING ↑P CODES, THEN FORGET WE DID LF
032 MOVEI TT,↑P ;OUTPUT A ↑P
033 PUSHJ P,TYOF6
034 HRRZ TT,(FXP) ;OUTPUT THE CHARACTER
035 PUSHJ P,TYOF6
036 HLRZ TT,(FXP)
037 041 040 JUMPE TT,CNPCD2
038 TRZ TT,400000 ;OUTPUT ANY ADDITIONAL MAGIC ARGUMENT
039 PUSHJ P,TYOF6
040 CNPCD2: POP FXP,TT
041 041 044 XCT CNPC9-"A(TT) ;ACCOUNT FOR THE EFFECTS OF THE ↑P CODE
042 .LOSE
043
044 042 018 CNPC9: JRST CNP.A ;A ADVANCE TO FRESH LINE
045 042 004 JRST CNP.B ;B MOVE BACK 1, WRAPAROUND
046 042 011 JRST CNP.C ;C CLEAR SCREEN
047 042 021 JRST CNP.D ;D MOVE DOWN, WRAPAROUND
048 JRST CZECHI ;E CLEAR TO EOF
049 042 026 JRST CNP.F ;F MOVE FORWARD 1, WRAPAROUND
050 JFCL
051 042 031 JRST CNP.H ;H SET HORIZONTAL POSITION
052 042 042 JRST CNP.I ;I NEXT CHARACTER IS ONE-POSITION PRINTING CHAR
053 JFCL
CONTROL-P CODES AND TTY INITIALIZATION QIO[NEW,LSP] 09/18/78 Page 41.1
054 JRST CZECHI ;K KILL CHARACTER UNDER CURSOR
055 JRST CZECHI ;L CLEAR TO END OF LINE
056 042 010 JRST CNP.M ;M GO INTO **MORE** STATE, THEN HOME UP
057 JRST CZECHI ;N GO INTO **MORE** STATE
058 JFCL
059 JFCL ;P OUTPUT A ↑P
060 JFCL ;Q OUTPUT A ↑C
061 JFCL ;R RESTORE CURSOR POSITION
062 JFCL ;S SAVE CURSOR POSITION
063 042 012 JRST CNP.T ;T TOP OF SCREEN (HOME UP)
064 042 046 JRST CNP.U ;U MOVE UP, WRAPPING AROUND
065 042 052 JRST CNP.V ;V SET VERTICAL POSITION
066 JFCL
067 042 003 JRST CNP.X ;X BACKSPACE AND ERASE ONE CHAR
068 JFCL
069 042 045 JRST CNP.Z ;Z HOME DOWN
070 042 013 JRST CNP.IL ;[ INSERT LINE ;BEWARE THE BRACKETS!
071 042 014 JRST CNP.DL ;\ DELETE LINE
072 JRST CZECHI ;] SAME AS L (OBSOLETE)
073 JRST CZECHI ;↑ INSERT CHARACTER
074 JRST CZECHI ;← DELETE CHARACTER
075
076 VAROPT: SETZ
077 SIXBIT \TTYVAR\
078 ,,F.CHAN(T) ;CHANNEL
079 [SIXBIT \TTYOPT\] ;READ THE TTYOPT VARIABLE
080 402000,,TT ;RETURN RESULT INTO TT
081
082 ;TABLE OF INSTRUCTIONS TO DETERMINE IF A ↑P CODE IS DOABLE ON THE TERMINAL
083 CNPOK: SKIPA ;A OK ON ALL TTY'S
084 TLNN TT,%TOMVB ;B ON TTY'S THAT CAN DO IT DIRECTLY
085 SKIPA ;C THIS HAS SOME AFFECT ON ALL TTY'S
086 SKIPA ;D
087 TLNN TT,%TOERS ;E REQUIRES %TOERS
088 SKIPA ;F
089 JFCL
090 SKIPA ;H
091 TLNN TT,%TOMVU ;I
092 JFCL
093 TLNN TT,%TOMVU ;K ASSUME ONLY ON DISPLAY TERMINALS
094 TLNN TT,%TOERS ;L
095 SKIPA ;M
096 SKIPA ;N
097 JFCL
098 SKIPA ;P
099 SKIPA ;Q
100 TLNN TT,%TOMVU ;R MAKE SAME ASSUMPTION AS K AND S
101 TLNN TT,%TOMVU ;S
102 TLNN TT,%TOMVU ;T WHEREAS C IS MEANINGFUL FOR NON-DISPLAYS, I
103 ; DO NOT FEEL THIS IS
104 TLNN TT,%TOMVU ;U
105 TLNN TT,%TOMVU ;V
106 JFCL
CONTROL-P CODES AND TTY INITIALIZATION QIO[NEW,LSP] 09/18/78 Page 41.2
107 ;X TTY'S THAT CAN BACKSPACE AND DON'T OVERSTRIKE
108 ; OR THAT CAN ERASE
109 PUSHJ P,[TLNN TT,%TOMVB ;MUST BE ABLE TO BACK-UP
110 POPJ P,
111 TLNN TT,%TOERS ;IF CAN ERASE IS OK
112 TLNN TT,%TOOVR ;OR IF DOESN'T OVERSTRIKE
113 AOS (P)
114 POPJ P,]
115 JFCL
116 TLNN TT,%TOMVU ;Z SAME CRITERIA AS ↑PT
117 TLNN TT,%TOLID ;[
118 TLNN TT,%TOLID ;\
119 TLNN TT,%TOERS ;] SAME AS ↑PL
120 TLNN TT,%TOCID ;↑
121 TLNN TT,%TOCID ;←
CONTROL-P CODES AND TTY INITIALIZATION QIO[NEW,LSP] 09/18/78 Page 42
001 ;;; IFN ITS
002
003 CNP.X: ;SAME AS ↑P K ↑P B
004 CNP.B: MOVE D,FO.LNL(T) ;MOVE BACKWARDS
005 SUBI D,1
006 SOSGE AT.CHS(T) ;WRAP AROUND IF AT LEFT MARGIN
007 MOVEM D,AT.CHS(T)
008 JRST CZECHI
009
010 CNP.M: ;DOES **MORE**, THEN HOMES UP
011 CNP.C: AOS AT.PGN(T) ;CLEAR SCREEN - AOS PAGENUM
012 CNP.T: SETZM AT.LNN(T) ;HOME UP - CLEAR LINENUM AND CHARPOS
013 CNP.IL: ;INSERT LINE - CLEAR CHARPOS
014 CNP.DL: ;DELETE LINE - CLEAR CHARPOS
015 SETZM AT.CHS(T)
016 JRST CZECHI
017
018 CNP.A: SKIPN AT.CHS(T) ;CRLF, UNLESS AT START OF LINE
019 JRST CZECHI
020 SETZM AT.CHS(T) ;CLEAR CHARPOS, THEN INCR LINENUM
021 CNP.D: AOS D,AT.LNN(T) ;MOVE DOWN
022 CAML D,FO.PGL(T) ;WRAP AROUND OFF BOTTOM TO TOP
023 SETZM AT.LNN(T)
024 JRST CZECHI
025
026 CNP.F: AOS D,AT.CHS(T) ;MOVE FORWARD - WRAP AROUND
027 CAML D,FO.LNL(T) ; OFF END TO LEFT MARGIN
028 SETZM AT.CHS(T)
029 JRST CZECHI
030
031 CNP.H: HLRZ D,TT ;SET HORIZONTAL POSITION
032 TRZ D,400000 ;CLEAR LISP'S FLAG (IF PRESENT)
033 SUBI D,7 ;ACCOUNT FOR ITS'S 8
034 SKIPGE FO.LNL(T) ;IF NEGATIVE, THEN ASSUME C(D) IS ACTUAL HPOS
035 042 038 JRST CNP.H1
036 CAMLE D,FO.LNL(T) ;PUT ON RIGHT MARGIN IF TOO BIG
037 MOVE D,FO.LNL(T)
038 CNP.H1: SUBI D,1
039 MOVEM D,AT.CHS(T)
040 JRST CZECHI
041
042 CNP.I: AOS AT.CHS(T) ;NOT REALLY THE RIGHT THING, BUT CLOSE
043 JRST CZECHI
044
045 CNP.Z: SETZM AT.LNN(T) ;HOME DOWN (GO UP FROM TOP!)
046 CNP.U: MOVE D,FO.RPL(T) ;MOVE UP
047 SUBI D,1 ;WRAP AROUND FROM TOP TO BOTTOM
048 SOSGE AT.LNN(T) ; USING "REAL" PAGE LENGTH
049 MOVEM D,AT.LNN(T)
050 JRST CZECHI
051
052 CNP.V: HLRZ D,TT ;SET VERTICAL POSITION
053 SUBI D,7 ;IF TOO LARGE, PUT ON BOTTOM
CONTROL-P CODES AND TTY INITIALIZATION QIO[NEW,LSP] 09/18/78 Page 42.1
054 CAMLE D,FO.RPL(T)
055 MOVE D,FO.RPL(T)
056 SUBI D,1
057 MOVEM D,AT.LNN(T)
058 JRST CZECHI
059
060
061
062 ;;; VARIOUS ROUTINES FOR PRINTING ↑P CODES
063
064 CNPBBL: MOVEI D,"B
065 041 014 PUSHJ P,CNPCOD
066 CNPBL: MOVEI D,"B
067 041 014 PUSHJ P,CNPCOD
068 CNPL: MOVEI D,"L
069 041 014 JRST CNPCOD
070
071 CNPU: MOVEI D,"U
072 041 014 JRST CNPCOD
073
074 CNPF: MOVEI D,"F
075 041 014 JRST CNPCOD
076
077 CLRSRN: MOVEI D,"C
078 041 014 JRST CNPCOD
079
080 ] ;END OF IFN ITS
081
082 IFN D20,[
083 042 077 WARN [TOPS-20 CLRSRN]
084 CLRSRN: POPJ P, ;PUNT THIS FOR NOW
085 ] ;END IFN D20
CONTROL-P CODES AND TTY INITIALIZATION QIO[NEW,LSP] 09/18/78 Page 43
001 ;;; ROUTINE FOR OPENING UP THE INITIAL TTY FILE ARRAYS.
002 ;;; SKIPS ON SUCCESS (FAILS IF THIS JOB NEVER HAD THE TTY).
003
004 IT$ OPNTTY:
005 IFN ITS,[
006 .SUSET [.RTTY,,T] ;GET .TTY USER VARIABLE
007 TLNE T,%TBWAT ;IF SUPERIOR SET %TBWAT, IT CERTAINLY
008 043 014 JRST OPNT0 ; ANTICIPATES OUR OPENING TTY - LET'S OBLIGE
009 TLNE T,%TBNOT ;ELSE DON'T OPEN IF WE DON'T HAVE THE TTY
010 ] ;END OF IFN ITS
011 043 023 COPNT1: POPJ P,OPNT1
012 20$ WARN [SHOULD WE NOT OPEN TTY IF DETACHED, OR CHECK .PRIIN?]
013 IT% OPNTTY:
014 OPNT0: AOS (P)
015 HRRZ A,V%TYO
016 MOVEI TT,FO.EOP
017 PUSH P,@TTSAR(A)
018 043 011 PUSH P,COPNT1 ;OPEN UP TTY OUTPUT ARRAY
019 PUSH P,A
020 MOVNI T,1
021 021 002 JRST $OPEN
022
023 OPNT1: MOVEI AR1,(A)
024 POP P,A
025 MOVEI TT,FO.EOP
026 MOVEM A,@TTSAR(AR1)
027 MOVEI TT,FO.LNL
028 MOVE TT,@TTSAR(AR1)
029 MOVEM TT,DLINEL ;SET UP DEFAULT LINEL FROM INITIAL JOB CONSOLE
030 MOVEI TT,FO.PGL
031 MOVE TT,@TTSAR(AR1)
032 MOVEM TT,DPAGEL ;SET UP DEFAULT PAGEL "
033 043 037 PUSH P,[OPNT1A]
034 PUSH P,AR1
035 MOVNI T,1
036 JRST STTYTYPE
037 OPNT1A: MOVEM A,VTTY ;INITIALIZE "TTY" TO (STATUS TTYTYPE)
038 HRRZ A,V%TYI
039 MOVEI TT,TI.BFN
040 PUSH P,@TTSAR(A)
041 IFN ITS+D20+SAIL,[
042 MOVEI TT,TI.ST1
043 PUSH FXP,@TTSAR(A)
044 MOVEI TT,TI.ST2
045 PUSH FXP,@TTSAR(A)
046 IFN SAIL,[
047 MOVEI TT,TI.ST3
048 PUSH FXP,@TTSAR(A)
049 MOVEI TT,TI.ST4
050 PUSH FXP,@TTSAR(A)
051 ] ;END OF IFN SAIL
052 ] ;END OF IFN ITS+D20+SAIL
053 043 089 PUSH P,COPNT2 ;OPEN UP TTY INPUT ARRAY
CONTROL-P CODES AND TTY INITIALIZATION QIO[NEW,LSP] 09/18/78 Page 43.1
054 PUSH P,V%TYI
055 MOVNI T,1
056 021 002 JRST $OPEN
057
058 OPNT2:
059 IFN ITS+D20+SAIL,[
060 SA$ POP FXP,T
061 SA$ POP FXP,F
062 POP FXP,R ;BEWARE THE LOCKI WORD!
063 POP FXP,D
064 ] ;END OF IFN ITS+D20+SAIL
065 LOCKI
066 MOVE TT,TTSAR(A)
067 POP P,TI.BFN(TT)
068 IFN ITS+D20+SAIL,[
069 MOVEM D,TI.ST1(TT)
070 MOVEM R,TI.ST2(TT)
071 SA$ MOVEM F,TI.ST3(TT)
072 SA$ MOVEM T,TI.ST4(TT)
073 IT$ .CALL TTY2ST
074 IT$ .LOSE 1400
075 SA$ MOVEI T,TI.ST1(TT)
076 SA$ SETACT T
077 IFN D20,[
078 HRRZ 1,F.JFN(TT)
079 MOVE 2,TI.ST1(TT)
080 MOVE 3,TI.ST2(TT)
081 SFCOC
082 SETZB 2,3
083 ] ;END OF IFN D20
084 ] ;END OF IFN ITS+D20+SAIL
085 UNLOCKI
086 HRRZ A,V%TYI
087 HRRZ B,V%TYO
088 PUSHJ P,SSTTYCONS ;CONS THEM TOGETHER AS CONSOLE
089 043 058 COPNT2: POPJ P,OPNT2
090
CLEAR-INPUT, CLEAR-OUTPUT QIO[NEW,LSP] 09/18/78 Page 44
001 SUBTTL CLEAR-INPUT, CLEAR-OUTPUT
002
003 ;;; (CLEAR-INPUT X) CLEARS ANY PENDING INPUT.
004 ;;; CURRENTLY ONLY EFFECTIVE FOR TTY'S.
005
006 CLRIN: PUSH P,AR1 ;SUBR 1
007 MOVEI AR1,(A)
008 005 010 PUSHJ P,IFILOK ;MAKE SURE ARGUMENT IS AN INPUT FILE
009 TLNE TT,TTS.TY
010 044 013 PUSHJ FXP,CLRI3 ;IF A TTY, CLEAR ITS INPUT
011 038 056 JRST $OUT1
012
013 CLRI3:
014 IFN ITS,[
015 044 034 .CALL CLRIN9 ;RESET TTY INPUT AT ITS LEVEL
016 .LOSE 1400
017 ] ;END OF IFN ITS
018 IFN D10,[
019 MOVE D,F.DEV(TT)
020 CAMN D,[SIXBIT \TTY\]
021 CLRBFI
022 ] ;END OF IFN D10
023 IFN D20,[
024 PUSH P,A
025 HRRZ 1,F.JFN(TT)
026 CFIBF ;CLEAR FILE INPUT BUFFER
027 POP P,A
028 ] ;END OF IFN D20
029 SETZM FI.BBC(TT) ;CLEAR BUFFERED-BACK CHARS
030 ; SETZM FI.BBF(TT) ;CLEAR BUFFERED-BACK FORMS
031 POPJ FXP,
032
033 IFN ITS,[
034 CLRIN9: SETZ
035 SIXBIT \RESET\ ;RESET I/O CHANNEL
036 400000,,F.CHAN(TT) ;CHANNEL #
037 ] ;END OF IFN ITS
CLEAR-INPUT, CLEAR-OUTPUT QIO[NEW,LSP] 09/18/78 Page 45
001 ;;; (CLEAR-OUTPUT X) CLEARS ANY OUTPUT NOT ACTUALLY ON
002 ;;; THE OUTPUT DEVICE YET. CURRENTLY ONLY EFFECTIVE FOR TTY'S.
003
004 CLROUT: PUSH P,AR1 ;SUBR 1
005 MOVEI AR1,(A)
006 005 006 PUSHJ P,OFILOK
007 TLNE TT,TTS<TY> ;SKIP IF TTY
008 045 011 PUSHJ FXP,CLRO3
009 038 056 JRST $OUT1
010
011 CLRO3:
012 IFN ITS,[
013 044 034 .CALL CLRIN9 ;RESET CHANNEL
014 .LOSE 1400
015 045 049 CLRO4: .CALL RCPOS1 ;RESET CHARPOS AND LINEL
016 .LOSE 1400
017 HLL T,F.MODE(TT)
018 TLNE T,FBT.EC
019 MOVE D,R ;FOR ECHO MODE, USE ECHO MODE CURSORPOS
020 HLRZM D,AT.LNN(TT)
021 HRRZM D,AT.CHS(TT)
022 ] ;END OF IFN ITS
023 IFN D10,[
024 MOVE D,F.DEV(TT)
025 CAMN D,[SIXBIT \TTY\]
026 CLRBFO
027 ] ;END OF IFN D10
028 IFN D20,[
029 PUSH P,A
030 HRRZ 1,F.JFN(TT)
031 CFOBF ;CLEAR FILE OUTPUT BUFFER
032 CAIA
033 CLRO4: PUSH P,A
034 PUSH P,B
035 HRRZ 1,F.JFN(TT)
036 RFPOS ;READ FILE POSITION
037 HLRZM 2,AT.LNN(TT) ;STORE LINENUM
038 HRRZM 2,AT.CHS(TT) ;STORE CHARPOS
039 POP P,B
040 POP P,A
041 ] ;END OF IFN D20
042 10% PUSH FXP,T
043 10% TLNN T,FBT.CM ;IF BLOCK MODE, RESET
044 017 082 10% JSP D,FORCE6 ; LISP BUFFER POINTERS
045 10% POP FXP,T
046 POPJ FXP,
047
048 IFN ITS,[
049 RCPOS1: SETZ
050 SIXBIT \RCPOS\ ;READ CURSOR POSITION
051 ,,F.CHAN(TT) ;CHANNEL #
052 2000,,D ;MAIN CURSOR POSITION
053 402000,,R ;ECHO CURSOR POSITION
CLEAR-INPUT, CLEAR-OUTPUT QIO[NEW,LSP] 09/18/78 Page 45.1
054 ] ;END OF IFN ITS
CLEAR-INPUT, CLEAR-OUTPUT QIO[NEW,LSP] 09/18/78 Page 46
001 ;;; STANDARD **MORE** PROCESSOR
002
003 TTYMOR: PUSHJ P,STTYCONS ;SUBR 1
004 JUMPE A,CPOPJ ;STTYCONS LEFT ARG IN AR1
005 PUSH P,AR1
006 PUSH P,A
007 SETZ A, ;RESET NOINTERRUPT STATUS
008 PUSHJ P,NOINTERRUPT ; SO INTERRUPT CHARS WILL TAKE EFFECT
009 HRRZ AR1,-1(P)
010 STRT AR1,[SIXBIT \####MORE####!\] ;# IS QUOTE CHAR
011 046 016 TTYMO3: PUSH P,[TTYMO1]
012 PUSH P,R70
013 PUSH P,-2(P)
014 MOVNI T,2
015 JRST TYIPEEK+1
016 046 023 TTYMO1: PUSH P,[TTYMO2]
017 PUSH P,-1(P)
018 MOVNI T,1
019 CAILE TT,40
020 CAIN TT,177
021 JRST %TYI+1 ;SWALLOW SPACE OR RUBOUT
022 POPI P,2
023 TTYMO2: CAIE TT,↑S ;DON'T IGNORE ↑S
024 CAIN TT,33 ;OR <ALT>
025 046 028 JRST TTYMOZ
026 CAIGE TT,40 ;COMPLETELY IGNORE CONTROL CHARS
027 046 003 JRST TTYMO3 ? SA$ WARN [SAIL TTYMOR?]
028 TTYMOZ: POPI P,1
029 POP P,AR1
030 IT% POPJ P,
031 IFN ITS,[
032 MOVE D,[10,,"H] ;GO TO BEGINNING OF LINE
033 041 014 PUSHJ P,CNPCOD
034 042 068 PUSHJ P,CNPL ;CLEAR TO END OF LINE
035 HRLI AR1,600000 ;FLAG TO TERPRI (THIS IS ACTUAL FILE ARRAY)
036 JRST TERP1 ;DO SEMI-INTERNAL TERPRI
037 ] ;END OF IFN ITS
038
SFA FUNCTIONS (INTERNAL AND USER) QIO[NEW,LSP] 09/18/78 Page 47
001 IFN SFA,[
002 SUBTTL SFA FUNCTIONS (INTERNAL AND USER)
003
004 ; (SFA-CREATE <old-sfa or sfa-function>
005 ; <amount-of-local-user-storage>
006 ; <printname>)
007 STCREA: SKOTT A,LS\SY
008 047 079 JRST STCRE1
009 ;HERE TO CREATE A NEW SFA: SFA-FUNCTION IN A, LISP FIXNUM IN B
010 STCREN: SKOTT B,FX ;FIXNUM AS SECOND ARG?
011 047 072 JRST STCRE2 ;NOPE, ERROR
012 PUSH P,A
013 PUSH P,B
014 PUSH P,C
015 MOVE TT,(B) ;GET THE LENGTH OF THE USER AREA
016 ADDI TT,<SR.LEN*2>+1 ;TO INSURE GETTING ENOUGH HALFWORDS
017 LSH TT,-1 ;THEN CONVERT TO NUMBER OF WORDS
018 MOVSI A,-1 ;JUST NEED THE SAR
019 PUSHJ P,MKLSAR ;GET A GC-PROTECTED ARRAY
020 POP P,C
021 LOCKI ;GOING TO HACK WITH THE ARRAY
022 MOVE TT,TTSAR(A) ;POINTER TO THE ARRAY DATA AREA
023 POP P,B ;LENGTH OF THE USER DATA AREA
024 MOVE T,(B)
025 MOVEM T,SR.UDL(TT) ;REMEMBER LENGTH OF USER DATA
026 EXCH A,(P) ;RESTORE FUNCTION AND SAVE SAR ADR
027 HRLI A,(CALL 3,) ;A CALL FUNCTION GOES IN UN-MARKED-FROM SLOT
028 MOVEM A,SR.CAL(TT) ;STORE THE CALL INSTRUCTION
029 HRRZM A,SR.FUN(TT) ;STORE THE FUNCTION
030 HRRZM C,SR.PNA(TT) ;STORE THE PRINTNAME
031 ROT T,-1 ;LENGTH OF USER AREA IN T
032 SKIPGE T ;CONVERT INTO NUMBER OF WORDS NEEDED
033 ADDI T,1
034 ADDI T,SR.LEN-SR.FML ;NUMBER OF SYSTEM WORDS MARKED
035 MOVNI R,(T) ;NUMBER OF WORDS TO MARK
036 HRLZI R,(R) ;IN LEFT HALF
037 HRRI R,SR.FML(TT) ;POINTER TO FIRST MARKED LOCATION IN RH
038 HRRZ D,@(P) ;GET SAR
039 MOVEM R,-1(D) ;STORE GC MARKING AOBJN POINTER
040 HRLZI TT,AS.SFA ;TURN THE ARRAY INTO AN SFA
041 IORM TT,@(P) ;TURN ON SFA BIT IN THE SAR
042 UNLOCKI ;ALLOW INTERRUPTS AGAIN
043 ;THE FOLLOWING CODE SIMULATES:
044 ; (SFA-CALL <NEWLY-CREATED-SFA> 'WHICH-OPERATIONS NIL)
045 HRRZ A,(P) ;FIRST ARG TO SFA IS SFA-OBJCT ITSELF
046 MOVEI B,QWOP ;WHICH-OPERATIONS
047 SETZ C, ;NO THIRD ARG
048 MOVEI TT,SR.CAL ;CALL INSTRUCTION SLOT
049 XCT @TTSAR(A) ;DO CALL INDIRECTLY THROUGH TTSAR
050 047 067 JUMPE A,STCRE3 ;THE SFA CAN'T DO ANYTHING, BUT WHY WORRY...
051 SKOTT A,LS ;BETTER HAVE GOTTEN A LIST BACK
052 047 077 JRST SCREBS ;BAD SFA IF DIDN'T GET BACK A LIST!
053 STMASK: SETZ F, ;F ACCUMLATES KNOWN SYSTEM OPERATIONS MASK
SFA FUNCTIONS (INTERNAL AND USER) QIO[NEW,LSP] 09/18/78 Page 47.1
054 047 083 STCRE4: MOVE R,[-STKNOL,,STKNOT] ;AOBJN POINTER OVER KNOWN OPERATIONS
055 HLRZ B,(A) ;CAR IS THE OPERATION
056 STCRE5: HRRZ T,(R) ;KNOWN OPERATIOON
057 CAIE T,(B) ;MATCH?
058 047 064 JRST STCRE6 ;NOPE, KEEP LOOPING
059 HRRZ T,R ;GET POINTER
060 HLLZ TT,(R) ;GET MASK
061 047 083 CAIL R,STKNOT+18. ;LEFT HALF VALUE?
062 MOVSS TT ;NOPE, ASSUMED WRONG
063 TDOA F,TT ;ACCUMLATE THIS OPERATION AND EXIT LOOP
064 047 056 STCRE6: AOBJN R,STCRE5 ;CONTINUE LOOPING UNTIL ALL LOOPED OUT
065 HRRZ A,(A) ;CDR DOWN THE WHICH-OPERATIONS LIST
066 047 054 JUMPN A,STCRE4 ;DON'T JUMP IF DON'T HAVE TO
067 STCRE3: POP P,A ;POINTER TO SAR
068 MOVEI TT,SR.WOM ;POINT TO KNOWN OPERATIONS MASK
069 MOVEM F,@TTSAR(A) ;STORE IN ARRAY
070 POPJ P, ;THEN RETURN SAR
071
072 STCRE2: EXCH B,A ;C(B) WAS NOT A FIXNUM
073 WTA [FIRST ARG MUST BE A FIXNUM -- SFA-CREATE!]
074 EXCH B,A
075 047 010 JRST STCREN
076
077 SCREBS: FAC [WAS RETURNED FROM WHICH-OPERATIONS BUT SHOULD HAVE BEEN A LIST -- SFA-CREATE!]
078
079 STCRE1: FAC [CALLED WITH SFA, NOT IMPLIMENTED -- SFA-CREATE!]
080
081
082 ;SFA OPERATION/INTERNAL BIT CORRESPONDANCE TABLE
083 STKNOT:
084 ;LH BITS
085 SO.OPN,,Q$OPEN
086 SO.CLO,,Q$CLOSE
087 SO.REN,,Q$RENAMEF
088 SO.DEL,,Q$DELETEF
089 SO.TRP,,Q%TERPRI
090 SO.PR1,,Q%PR1
091 SO.TYI,,Q%TYI
092 SO.UNT,,QUNTYI
093 SO.TIP,,QTYIPEEK
094 SO.IN,,Q$IN
095 SO.EOF,,QEOFFN
096 SO.TYO,,Q%TYO
097 SO.OUT,,Q$OUT
098 SO.FOU,,QFORCE
099 SO.RED,,QOREAD
100 SO.RDL,,Q%READLINE
101 SO.PRT,,Q%PRINT
102 SO.PRC,,Q%PRC
103
104 ;RH BITS
105 SO.MOD,,QFILEMODE
106 SO.POS,,QFILEPOS
SFA FUNCTIONS (INTERNAL AND USER) QIO[NEW,LSP] 09/18/78 Page 47.2
107
108 047 083 STKNOL==:.-STKNOT ;LENGTH OF TABLE
109
110
111 ;;; (SFA-CALL <sfa-object> <operation> <extra-arg>)
112 STCAL1: WTA [SHOULD BE AN SFA OBJECT -- SFA-CALL!]
113 STCALL: SKOTT A,SA ;MUST BE AN ARRAY HEADER
114 047 112 JRST STCAL1
115 HRLZI TT,AS.SFA ;NOW CHECK FOR SFA-NESS
116 TDNN TT,ASAR(A)
117 047 112 JRST STCAL1 ;AN ARRAY BUT NOT A REAL SFA
118 MOVEI TT,SR.CAL
119 XCT @TTSAR(A) ;INVOKE THE SFA
120 POPJ P,
121
122 ;INTERNAL SFA CALL, BIT INDICATNG OP IN T, SFA-OBJECT IN AR1,
123 ; THIRD ARG TO SFA IN C. RETURNS VALUE OF SFA IN A. DESTORYS ALL
124 ; ACS.
125 047 127 ISTCAL: JFFO T,ISTCA0 ;MUST HAVE ONE BIT SET
126 LERR [SIXBIT \+INTERNAL-SFA-CALL CALLED WITH NO OP IN T!\]
127 047 083 ISTCA0: HRRZ B,STKNOT(TT) ;GET SYMBOL REPRESENTING OPERATION
128 MOVEI A,(AR1) ;SFA GETS ITSELF AS FIRST ARG
129 MOVEI TT,SR.WOM ;CHECK FOR LEGAL OP -- USE WHICH OP MASK
130 TDNN T,@TTSAR(A) ;MAKE SURE THIS INTERNAL OP IS DOABLE
131 047 137 JRST ISTCA1
132 ;ENTER HERE FOR 'SHORT' INTERNAL CALL PROTOCOL, A, B, AND C SET UP CORRECTLY
133 ISTCSH: MOVEI TT,SR.CAL ;EXECUTE THE CALL TO THE SFA
134 XCT @TTSAR(A)
135 POPJ P, ;RETURN TO CALLER WITH RESULT IN A
136
137 047 143 ISTCA1: PUSH P,[ISTCA2] ;RETURN ADDRESS
138 PUSH P,A ;LISTIFY IMPORTANT INFO
139 PUSH P,B
140 PUSH P,C
141 MOVNI T,3 ;3 ARGS
142 JRST LIST ;DO IT!
143 ISTCA2:
144 FAC [ATTEMPT TO INVOKE SFA ON AN UNSUPPORTED OPERATION -- +INTERNAL-SFA-CALL!]
145
146
147 ;;; (SFAP <object>) RETURNS T IF <object> IS AN SFA, ELSE NIL
148 004 005 STPRED: JSP TT,AFOSP ;CHECK IF A FILE OR SFA
149 JRST FALSE ;NEITHER, RETURN NIL
150 JRST FALSE ;FILE, RETURN FALSE
151 JRST TRUE ;SFA, RETURN TRUE
152
153
154 ;;; (SFA-GET <sfa-object> <fixnum or system-location-name>)
155 ;;; (SFA-STORE <sfa-object> <fixnum or system-location-name> <new-value>)
156
157 047 226 STSTOR: SKIPA F,[STSTOD] ;SFA-STORE DISPATCH TABLE
158 047 194 STGET: MOVEI F,STGETD ;SFA-GET DISPATCH TABLE
159 SKIPA
SFA FUNCTIONS (INTERNAL AND USER) QIO[NEW,LSP] 09/18/78 Page 47.3
160 STDISW: WTA [NOT AN SFA -- SFA-GET/SFA-STORE!]
161 004 005 JSP TT,AFOSP ;INSURE WE HAVE AN SFA, A ==> AR1
162 047 160 JRST STDISW ;NOT AN SFA
163 047 160 JRST STDISW ;A FILE-OBJECT, BUT STILL NOT AN SFA
164 SKOTT B,FX ;FIXNUM AS SECOND ARG?
165 047 176 JRST STDIS1 ;NOPE, MUST BE A SYSTEM-LOCATION NAME
166 MOVE R,(B) ;GET THE ACTUAL FIXNUM
167 MOVEI TT,SR.UDL ;CHECK AGAINST THE MAXIMUM VALUE
168 CAML R,@TTSAR(AR1) ;IN RANGE?
169 047 173 JRST STDIOB ;NOPE, GIVE OUT-OF-BOUNDS CALL
170 ROT R,-1 ;MAKE INTO AN OFFSET AND A FLAG BIT (RH/LH)
171 JRST @-1(F) ;GIVE USER LOCATION ACCESS RETURN
172
173 STDIOB: EXCH A,B ;GIVE AN OUT-OF-BOUNDS ERROR
174 FAC [USER-INDEX OUT-OF-BOUNDS -- SFA-GET/SFA-STORE!]
175
176 047 189 STDIS1: MOVE T,[-STRSLN,,0] ;FIND SYS-LOC THAT 2ND ARG IS EQ TO
177 047 186 STDIS2: CAME B,STSYSL(T) ;MATCH THIS ENTRY?
178 047 177 AOBJN T,STDIS2 ;NOPE, CONTINUE THE LOOP
179 ADDI T,(F) ;MAKE CORRECT TABLE ADDRESS
180 SKIPGE T ;BUT DID WE REALY FIND A MATCH?
181 JRST @(T) ;YES, SO DISPATCH
182 EXCH A,B
183 FAC [ILLEGAL SYSTEM-LOCATION NAME -- SFA-GET/SFA-STORE!]
184
185 ;SFA SYSTEM-NAME TABLE
186 STSYSL: QFUNCTION ;FUNCTION
187 QWOP ;WHICH-OPERATIONS
188 QPNAME ;PNAME
189 047 186 STRSLN==:.-STSYSL
190
191 ;SFA-GET DISPATCH TABLE AND FUNCTIONS
192
193 047 198 STGETU ;USER LOCATION
194 047 205 STGETD: STGFUN ;FUNCTION
195 047 209 STGWOM ;OPERATIONS MASK
196 047 204 STGPNA ;PRINT NAME
197
198 STGETU: MOVEI TT,SR.FUS(R) ;INDEX INTO ARRAY
199 HLRZ A,@TTSAR(AR1) ;TRY THE LEFT HALF
200 SKIPGE R ;BUT IS IT THE RIGHT HALF?
201 HRRZ A,@TTSAR(AR1) ;YUP, SO FETCH THAT
202 POPJ P, ;RETURN SLOT'S VALUE
203
204 STGPNA: SKIPA TT,[SR.PNA] ;RETURN THE PNAME
205 STGFUN: MOVEI TT,SR.FUN ;RETURN THE FUNCTION
206 HRRZ A,@TTSAR(AR1)
207 POPJ P,
208
209 STGWOM: MOVEI TT,SR.WOM ;RETURN THE WHICH-OPERATIONS MASK
210 MOVE D,@TTSAR(AR1) ;GET THE MACHINE NUMBER AND CONS UP A FIXNUM
211 SETZ A, ;START OFF WITH NIL
212 047 214 STGWO1: JFFO D,STGWO2 ;ANY MORE LEFT TO DO?
SFA FUNCTIONS (INTERNAL AND USER) QIO[NEW,LSP] 09/18/78 Page 47.4
213 POPJ P, ;NOPE, RETURN WITH CONSED UP LIST IN A
214 047 083 STGWO2: HRRZ B,STKNOT(R) ;GET ATOM CORRESPONDING TO MASK BIT
215 JSP T,%XCONS ;ADD TO THE HEAD OF THE LIST
216 HRLZI T,400000 ;NOW TURN OFF THE BIT WE JUST HACKED
217 MOVNS R ;MUST NEGATE TO ROTATE
218 ROT T,(R) ;SHIFT INTO CORRECT BIT POSITION
219 TDZ D,T ;TURN OFF THE BIT
220 047 212 JRST STGWO1 ;AND DO THE REMAINING BITS
221
222
223 ;SFA-STORE DISPATCH TABLE AND ROUTINES
224
225 047 230 STSTOU ;USER LOCATION
226 047 240 STSTOD: STSFUN ;FUNCTION
227 047 253 STSWOM ;OPERATIONS MASK
228 047 239 STSPNA ;PRINT NAME
229
230 STSTOU: MOVEI TT,SR.FUS(R) ;INDEX INTO ARRAY
231 047 235 JUMPL R,STSTU1 ;RIGHT HALF
232 HRLM C,@TTSAR(AR1) ;STORE IN THE LEFT HALF
233 MOVEI A,(C) ;RETURN THE STORED VALUE
234 POPJ P, ;RETURN SLOT'S VALUE
235 STSTU1: HRRM C,@TTSAR(AR1) ;LEFT HALF
236 MOVEI A,(C)
237 POPJ P,
238
239 STSPNA: SKIPA TT,[SR.PNA] ;STORE THE PNAME
240 STSFUN: MOVEI TT,SR.FUN ;STORE THE FUNCTION
241 HRRZM C,@TTSAR(AR1)
242 MOVEI A,(C) ;RETURN THE STORED VALUE
243 CAIE TT,SR.FUN ;WERE WE HACKING THE FUNCTION?
244 POPJ P, ;NO, SO WE ARE DOINE
245 HRLI C,(CALL 3,) ;WE MUST ALSO FIX THE CALL INSTRUCTION
246 MOVEI TT,SR.CAL
247 MOVEM C,@TTSAR(AR1)
248 POPJ P,
249
250 STSWO1: EXCH A,C
251 WTA [MUST BE A LIST -- SFA-STORE (WHICH-OPERATIONS)!]
252 EXCH A,C
253 STSWOM: SKOTT C,LS ;IS THE ARGUMENT A LIST?
254 047 250 JRST STSWO1 ;NOPE, WRONG TYPE ARG ERROR
255 PUSH P,AR1 ;SAVE THE SFA FOR STMASK ROUTINE
256 MOVEI A,(C) ;EXPECTS WHICH-OPERATIONS LIST IN A
257 047 053 JRST STMASK ;THEN GENERATE A NEW MASK AND RETURN
258 ] ;END IFN SFA
259
260 PGTOP QIO,[NEW I/O PACKAGE]
261 β
Symbol Table for: QIO[NEW,LSP] 09/18/78 Page I
$CLOSE 016*009 ACCESS 031 017 CNP.Z 042 045 FLFRF1 036 081 JCLOSE 016 050 NMS.RB = 009 031
$DEL3 015 058 AFILEP 004 006 CNPBBL 042*064 FLFRFL 036 080 JFN6BT 010 030 NMS.ST = 009 033
$DEL4 015 110 AFOSP 004 005 CNPBL 042*066 FLFROB 036 046 JFN6ER 010 060 NMS.XT = 009 028
$DEL5 015 106 AFOSP 004 026 CNPC9 041 044 FLFWNA 036 040 LDGTW5 032*033 NMS6B0 009 038
$DEL5 015 111 AGREE 008*045 CNPCD1 041 031 FLNSFL 036 043 LIDNTB = 006 366 NMS6B0 010 006
$DEL6 015 053 ALCHAN 002 027 CNPCD2 041 040 FORCE 017 005 LINEL 036*006 NMS6B1 009 087
$DEL7 015 097 ALCHN0 002 028 CNPCOD 041 014 FORCE1 017 024 LINENU 036*025 NMS6B2 010 057
$DEL9 015 113 ALCHN1 002 029 CNPCUR 041*022 FORCE6 017 082 LISTEN 035 068 NMS6B4 009 159
$DEL9A 015 114 ALCHN2 002 041 CNPF 042*074 FORCE9 017 035 LOAD 019*013 NMS6B5 009 122
$DELET 015*005 ALCHN3 002 051 CNPL 042 068 FORSF1 017 016 LOAD1 019 063 NMS6B6 009 113
$DELNS 015 013 ALCHN9 002 058 CNPOK 041 083 FP1SF1 039 046 LOAD2 019 077 NMS6B7 009 129
$EOPEN 021 001 ALFILE 003*019 CNPU 042*071 FP5SF1 040 014 LOAD3 019 071 NMS6B7 010 070
$EOPEN 033 060 ATFLOK 005 014 CNSGET 029 021 FPOS0 039 028 LOAD4 019 085 NMS6B8 009 101
$EOPN1 033 066 ATIFOK 005*022 COPNT1 043 011 FPOS0A 039 030 LOAD5 019 029 NMS6B9 009 149
$EOPN2 033 072 ATOFOK 005 018 COPNT2 043 089 FPOS0B 039*022 LOAD6 019 035 NMS6BL 009 168
$EOPN3 033 078 C6BTNM 012 104 D10RFN 013 075 FPOS0C 039 023 LOAD7 019 048 NMS6BQ 009 167
$EOPN4 033 110 CHARPO 036*018 DEFAUL 034 007 FPOS0D 039 024 LOAD7A 019 050 NMS6BT 009 039
$EOPN5 033 092 CLOSE0 016 006 DMRGF 012 028 FPOS0E 039 018 LOAD8 019 054 NMS6BT 010 010
$EOPN6 033 087 CLOSE4 016 062 DMRGF5 012 062 FPOS1 039 037 LOPMDS = 022 019 NMS6BZ 010 053
$EOPN7 033 096 CLOSE9 016 044 ENDPAG 034*021 FPOS1A 039 056 MERGEF 012*008 NMS6CM 009 202
$EOPN8 033 099 CLRI3 044 013 EOFFN 034*029 FPOS1C 039 061 MORE G 046*010 NMS6DV 009 171
$EOPN9 033 103 CLRIN 044*006 EOFFN0 034 034 FPOS2 039 066 MRGF1 012 018 NMS6L1 009 199
$FASLP 019*097 CLRIN9 044 034 EOFFN2 034 054 FPOS5 040 002 MRGF2 012 070 NMS6LB 009 195
$IN 037*006 CLRO3 045 011 EOFFN5 034 057 FPOS5A 040 019 NAMELI 007 009 NMS6PD 009 189
$IN1 037 067 CLRO4 045 015 EOFFN7 034 078 FPOS6 040 039 NAMEST 008 013 NMS6PP 009 241
$IN2 037 060 CLRO4 045 033 EOFFNY 034 071 FPOS6A 040 112 NFILE 005 048 NMS6R1 009 230
$IN3 037 071 CLROUT 045*004 EOFFNZ 034 047 FPOS6B 040 105 NML6B0 006 099 NMS6R2 009 226
$IN4 037 095 CLRSRN 042 077 FASLP1 019 117 FPOS6C 040 100 NML6B2 006 104 NMS6RB 009 214
$IN7 037 121 CLRSRN 042 084 FASLP2 019 174 FPOS7 040 143 NML6B5 006 089 NMS6SN 009 181
$IN8 037 128 CNAER1 014 211 FASLP2 019 200 FPOSZ 040 070 NML6BT 006 088 NMS6ST 009 237
$INNOS 037 023 CNAER2 014 212 FASLP8 019 185 ICLOS6 016 041 NML6BZ 006 098 NSDERR 014 169
$LENFL 040 171 CNAME1 014 200 FASLP9 019 189 ICLOSE 016 017 NML6D1 006 222 OFILOK 005 006
$LENGT 040*153 CNAME2 014 199 FIL6B0 011 020 IDND 006 321 NML6D4 006 290 OPBITS 022 023
$LENWT 040 150 CNAME3 014 189 FIL6B1 011*022 IDND1 006 343 NML6D7 006 252 OPEN0J 021 021
$LISTE 035*005 CNAMEF 014*181 FIL6B2 011 043 IDND3 006 353 NML6D8 006 243 OPEN1A 021 029
$LSTN3 035 013 CNAMER 014*201 FIL6BT 011 018 IDNTB 006 360 NML6DV 006 199 OPEN1C 021 037
$LSTN4 035 044 CNP.A 042 018 FILEP 004*018 IFILOK 005 010 NML6F2 006 176 OPEN1F 021 041
$LSTN5 035 049 CNP.B 042 004 FILEPO 039 011 IFL6BT 011*010 NML6F3 006 192 OPEN1G 021 048
$LSTN6 035 048 CNP.C 042 011 FILLEN 031 012 IFORC1 017 057 NML6F4 006 189 OPEN1H 021*053
$LSTNS 035 025 CNP.D 042 021 FILNOK 005 069 IFORCE 017 045 NML6F5 006*171 OPEN1K 021 051
$OPEN 021 002 CNP.DL 042 014 FILOK 005 046 IMRGF 012 066 NML6FN 006 133 OPEN1L 023 013
$OPNNS 021 017 CNP.F 042 026 FILOK0 005 050 INCEOF = 019*221 NML6UF 006 135 OPEN1M 023 037
$OUT 038*005 CNP.H 042 031 FILOK1 005 058 INCLU1 019 216 NMS = 009*021 OPEN1N 023 056
$OUT1 038 056 CNP.H1 042 038 FILSFA 011 014 INCLUD 019*210 NMS.CA = 009 023 OPEN1P 023 058
$OUT2 038 049 CNP.I 042 042 FLFB1A 036 092 INSIOT 037 136 NMS.CM = 009 030 OPEN1Q 023 106
$OUT3 038 045 CNP.IL 042 013 FLFRB1 036 087 IOTTTT 017*090 NMS.CQ = 009 022 OPEN1R 023 102
$OUTNS 038 015 CNP.M 042 010 FLFRB3 036 095 ISTCA0 047 127 NMS.DT = 009 027 OPEN1S 023 029
$RENAM 014*007 CNP.T 042 012 FLFRB5 036 100 ISTCA1 047 137 NMS.DV = 009 025 OPEN1T 024 024
.JSAOF ← 010*034 CNP.U 042 046 FLFRB6 036 107 ISTCA2 047 143 NMS.FN = 009 026 OPEN1Y 023 017
.TTASC ← 027 063 CNP.V 042 052 FLFRB7 036 118 ISTCAL 047 125 NMS.LB = 009 029 OPEN1Z 021 058
.TTBIN V 027*065 CNP.X 042 003 FLFRB8 036 115 ISTCSH 047 133 NMS.ND = 009 032 OPEN3 025*014
Symbol Table for: QIO[NEW,LSP] 09/18/78 Page II
OPEN3C 025 069 OPN3D1 025 093 PAGEL 036*012 RENAM9 014 159 STGET 047*158 TOFLOK 005*034
OPEN3D 025 083 OPN3LA 026 106 PAGENU 036*032 RFNAME 014 172 STGETD 047 194 TRU6BT 012*124
OPEN3D 025 142 OPN3LB 026 113 PROBEF 013 025 SARGHT 006 304 STGETU 047 198 TRUENA 012 110
OPEN3E 025 113 OPNA6 027 008 PROBEZ 013 033 SCML 029 016 STGFUN 047 205 TRUNM2 012 126
OPEN3E 025 160 OPNAI1 027 007 PROBF0 013*035 SCREBS 047 077 STGPNA 047 204 TRUNM8 012 145
OPEN3F 025 118 OPNALZ 030 003 PROBF5 013 109 SFILEM 018*017 STGWO1 047 212 TRUNM9 012 146
OPEN3G 026 015 OPNAND 030 042 PROBF6 013 110 SFMD0 018 016 STGWO2 047 214 TRUNMZ 012 121
OPEN3H 026 126 OPNAO1 027 002 PROBF8 013 116 SFMD0A 018 034 STGWOM 047 209 TTYGET 029 002
OPEN3J 026 100 OPNAT3 029 032 PROBF9 013 125 SFMD1 018 056 STKNOL = 047 108 TTYMO1 046 016
OPEN3K 026 049 OPNAT5 029 036 QIOSAV 011 046 SHORTN 008*011 STKNOT 047 083 TTYMO2 046 023
OPEN3L 026 111 OPNBI1 027 006 RBFSIZ = 032 005 SIOT 017 095 STMASK 047 053 TTYMO3 046 011
OPEN3M 025 121 OPNBO1 027 001 RBFSIZ = 032 006 SSCRFI = 034*014 STPRED 047*148 TTYMOR 046 003
OPEN3N 025 123 OPNLZ0 030 022 RBFSIZ = 032 007 STCAL1 047 112 STRSLN = 047 189 TTYMOZ 046 028
OPEN3P 026 027 OPNLZ1 030 043 RCHST 031 022 STCALL 047*113 STSFUN 047 240 TTYSET 029 009
OPEN3Q 026 116 OPNLZ2 030 036 RCPOS1 045 049 STCRE1 047 079 STSPNA 047 239 UNLKPJ 003 039
OPEN3V 026 136 OPNLZ3 030 031 RENAM0 014 039 STCRE2 047 072 STSTOD 047 226 VAROPT 041 076
OPEN3Z 026 145 OPNLZR 030 048 RENAM1 014 084 STCRE3 047 067 STSTOR 047*157 X6BTNS 008 021
OPEN4 029*038 OPNT0 043 014 RENAM2 014 087 STCRE4 047 054 STSTOU 047 230 XCIOL 014 166
OPEN9A 032 013 OPNT1 043 023 RENAM3 014 125 STCRE5 047 056 STSTU1 047 235 XFILEP 004 008
OPEN9B 032 029 OPNT1A 043 037 RENAM4 014 148 STCRE6 047 064 STSWO1 047 250 XFOSP 004 007
OPEN9C 033 005 OPNT2 043 058 RENAM4 014 155 STCREA 047*007 STSWOM 047 253 XFOSP 004 027
OPEN9D 032 042 OPNTI1 027 023 RENAM5 014 150 STCREN 047 010 STSYSL 047 186 XIFLOK 005 038
OPENLZ 030 006 OPNTO1 028 001 RENAM5 014 156 STDIOB 047 173 SUREAD 012*156 XOFLOK 005 042
OPENUP 031 003 OPNTO5 028 023 RENAM6 014 158 STDIS1 047 176 SUWRIT 012*169 ZZZ = 012 051
OPMDS 022 004 OPNTTY 043*004 RENAM7 014 131 STDIS2 047 177 TFILOK 005*026 ZZZ = 012 053
OPN1F1 021*039 OPNTTY 043*013 RENAM8 014 137 STDISW 047 160 TIFLOK 005 030